https://gcc.gnu.org/g:39701cd22bf18c4172edb14e6ae502705b4da46c
commit 39701cd22bf18c4172edb14e6ae502705b4da46c
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Mon Feb 17 18:49:30 2025 +0100
Correction régression forall_13
Diff:
---
gcc/fortran/trans-array.cc | 86 ++++++++++++++++++++++++++----------------
gcc/fortran/trans-array.h | 3 +-
gcc/fortran/trans-expr.cc | 5 ++-
gcc/fortran/trans-intrinsic.cc | 8 ++--
gcc/fortran/trans-stmt.cc | 2 +-
gcc/fortran/trans.h | 1 +
6 files changed, 65 insertions(+), 40 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 9fe54c76e0d8..600f28b37962 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1908,17 +1908,20 @@ set_bounds_update_offset (stmtblock_t *block, tree
desc, int dim,
return;
/* Update offset. */
- tree tmp = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, lbound_diff, stride);
- tmp = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type, *offset, tmp);
- *offset = gfc_evaluate_now (tmp, block);
+ if (!integer_zerop (lbound_diff))
+ {
+ tree tmp = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, lbound_diff, stride);
+ tmp = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type, *offset, tmp);
+ *offset = gfc_evaluate_now (tmp, block);
+ }
if (!next_stride)
return;
/* Set stride for next dimension. */
- tmp = gfc_conv_array_extent_dim (lbound, ubound, NULL);
+ tree tmp = gfc_conv_array_extent_dim (lbound, ubound, NULL);
*next_stride = fold_build2_loc (input_location, MULT_EXPR,
gfc_array_index_type, stride, tmp);
}
@@ -3652,9 +3655,11 @@ get_class_info_from_ss (stmtblock_t * pre, gfc_ss *ss,
tree *eltype,
static void
set_temporary_descriptor (stmtblock_t *block, tree desc, tree class_src,
tree elemsize, tree data_ptr,
+ tree lbound[GFC_MAX_DIMENSIONS],
tree ubound[GFC_MAX_DIMENSIONS],
tree stride[GFC_MAX_DIMENSIONS], int rank,
- bool callee_allocated, bool rank_changer)
+ bool callee_allocated, bool rank_changer,
+ bool shift_bounds)
{
int n;
@@ -3680,13 +3685,15 @@ set_temporary_descriptor (stmtblock_t *block, tree
desc, tree class_src,
gfc_conv_descriptor_rank_set (block, desc, rank);
}
+ tree offset = gfc_index_zero_node;
if (!callee_allocated)
{
for (n = 0; n < rank; n++)
{
/* Store the stride and bound components in the descriptor. */
- set_descriptor_dimension (block, desc, n, gfc_index_zero_node,
ubound[n],
- stride[n], nullptr, nullptr);
+ tree this_lbound = shift_bounds ? gfc_index_zero_node : lbound[n];
+ set_descriptor_dimension (block, desc, n, this_lbound, ubound[n],
+ stride[n], &offset, nullptr);
}
}
@@ -3696,7 +3703,7 @@ set_temporary_descriptor (stmtblock_t *block, tree desc,
tree class_src,
/* The offset is zero because we create temporaries with a zero
lower bound. */
- gfc_conv_descriptor_offset_set (block, desc, gfc_index_zero_node);
+ gfc_conv_descriptor_offset_set (block, desc, offset);
}
@@ -3721,7 +3728,8 @@ set_temporary_descriptor (stmtblock_t *block, tree desc,
tree class_src,
tree
gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss *
ss,
tree eltype, tree initial, bool dynamic,
- bool dealloc, bool callee_alloc, locus * where)
+ bool dealloc, bool callee_alloc, locus * where,
+ bool shift_bounds)
{
gfc_loopinfo *loop;
gfc_ss *s;
@@ -3808,19 +3816,22 @@ gfc_trans_create_temp_array (stmtblock_t * pre,
stmtblock_t * post, gfc_ss * ss,
{
dim = s->dim[n];
- /* Callee allocated arrays may not have a known bound yet. */
- if (loop->to[n])
- loop->to[n] = gfc_evaluate_now (
- fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type,
- loop->to[n], loop->from[n]),
- pre);
- loop->from[n] = gfc_index_zero_node;
-
- /* We have just changed the loop bounds, we must clear the
- corresponding specloop, so that delta calculation is not skipped
- later in gfc_set_delta. */
- loop->specloop[n] = NULL;
+ if (shift_bounds)
+ {
+ /* Callee allocated arrays may not have a known bound yet. */
+ if (loop->to[n])
+ loop->to[n] = gfc_evaluate_now (
+ fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type,
+ loop->to[n], loop->from[n]),
+ pre);
+ loop->from[n] = gfc_index_zero_node;
+
+ /* We have just changed the loop bounds, we must clear the
+ corresponding specloop, so that delta calculation is not
skipped
+ later in gfc_set_delta. */
+ loop->specloop[n] = NULL;
+ }
/* We are constructing the temporary's descriptor based on the loop
dimensions. As the dimensions may be accessed in arbitrary order
@@ -3981,13 +3992,18 @@ gfc_trans_create_temp_array (stmtblock_t * pre,
stmtblock_t * post, gfc_ss * ss,
{
stride[n] = size;
- tmp = fold_build2_loc (input_location, PLUS_EXPR,
- gfc_array_index_type,
- to[n], gfc_index_one_node);
+ tree extent = to[n];
+ if (!shift_bounds && !integer_zerop (from[n]))
+ extent = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type, to[n], from[n]);
+
+ extent = fold_build2_loc (input_location, PLUS_EXPR,
+ gfc_array_index_type,
+ extent, gfc_index_one_node);
/* Check whether the size for this dimension is negative. */
cond = fold_build2_loc (input_location, LE_EXPR, logical_type_node,
- tmp, gfc_index_zero_node);
+ extent, gfc_index_zero_node);
cond = gfc_evaluate_now (cond, pre);
if (n == 0)
@@ -3997,7 +4013,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre,
stmtblock_t * post, gfc_ss * ss,
logical_type_node, or_expr, cond);
size = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, size, tmp);
+ gfc_array_index_type, size, extent);
size = gfc_evaluate_now (size, pre);
}
}
@@ -4025,9 +4041,9 @@ gfc_trans_create_temp_array (stmtblock_t * pre,
stmtblock_t * post, gfc_ss * ss,
dealloc);
set_temporary_descriptor (pre, desc, class_expr, elemsize, data_ptr,
- to, stride, total_dim,
+ from, to, stride, total_dim,
size == NULL_TREE || callee_alloc,
- rank_changer);
+ rank_changer, shift_bounds);
while (ss->parent)
ss = ss->parent;
@@ -5308,7 +5324,8 @@ trans_array_constructor (gfc_ss * ss, locus * where)
}
gfc_trans_create_temp_array (&outer_loop->pre, &outer_loop->post, ss, type,
- NULL_TREE, dynamic, true, false, where);
+ NULL_TREE, dynamic, true, false, where,
+ true);
desc = ss_info->data.array.descriptor;
offset = gfc_index_zero_node;
@@ -8195,6 +8212,8 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
gcc_assert (tmp_ss_info->type == GFC_SS_TEMP);
gcc_assert (loop->parent == NULL);
+ bool preserve_bounds = tmp_ss_info->data.temp.preserve_bounds;
+
/* Make absolutely sure that this is a complete type. */
if (tmp_ss_info->string_length)
tmp_ss_info->data.temp.type
@@ -8209,7 +8228,8 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
gcc_assert (tmp_ss->dimen != 0);
gfc_trans_create_temp_array (&loop->pre, &loop->post, tmp_ss, tmp,
- NULL_TREE, false, true, false, where);
+ NULL_TREE, false, true, false, where,
+ !preserve_bounds);
}
/* For array parameters we don't have loop variables, so don't calculate the
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 357bd64fb766..e0aa60b2e9b2 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -30,7 +30,8 @@ void gfc_set_loop_bounds_from_array_spec
(gfc_interface_mapping *,
/* Generate code to create a temporary array. */
tree gfc_trans_create_temp_array (stmtblock_t *, stmtblock_t *, gfc_ss *,
- tree, tree, bool, bool, bool, locus *);
+ tree, tree, bool, bool, bool, locus *,
+ bool shift_bounds);
/* Generate function entry code for allocation of compiler allocated array
variables. */
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 1a42a78f66a1..5cb073a56b2e 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -5445,6 +5445,7 @@ gfc_conv_subref_array_arg (gfc_se *se, gfc_expr * expr,
int g77,
? expr->ts.u.cl->backend_decl
: NULL),
loop.dimen);
+ loop.temp_ss->info->data.temp.preserve_bounds = 1;
parmse->string_length = loop.temp_ss->info->string_length;
@@ -8386,7 +8387,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
gfc_trans_create_temp_array (&se->pre, &se->post, se->ss,
tmp, NULL_TREE, false,
!comp->attr.pointer, callee_alloc,
- &se->ss->info->expr->where);
+ &se->ss->info->expr->where, true);
/* Pass the temporary as the first argument. */
result = info->descriptor;
@@ -8422,7 +8423,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
gfc_trans_create_temp_array (&se->pre, &se->post, se->ss,
tmp, NULL_TREE, false,
!sym->attr.pointer, callee_alloc,
- &se->ss->info->expr->where);
+ &se->ss->info->expr->where, true);
/* Pass the temporary as the first argument. */
result = info->descriptor;
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 40aea99924be..15528d407d9d 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -1858,7 +1858,8 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr,
tree lhs,
/* Create temporary. */
may_realloc = gfc_trans_create_temp_array (&se->pre, &se->post, se->ss,
type, NULL_TREE, false, false,
- false, &array_expr->where)
+ false, &array_expr->where,
+ true)
== NULL_TREE;
res_var = se->ss->info->data.array.descriptor;
if (array_expr->ts.type == BT_CHARACTER)
@@ -2094,7 +2095,7 @@ conv_caf_send (gfc_code *code) {
gfc_trans_create_temp_array (&lhs_se.pre, &lhs_se.post,
lss_for_tmparray, lhs_type, NULL_TREE,
false, true, false,
- &lhs_expr->where);
+ &lhs_expr->where, true);
tmparr_desc = lss_for_tmparray->info->data.array.descriptor;
gfc_start_scalarized_body (&loop, &body);
gfc_init_se (&se, NULL);
@@ -9338,7 +9339,8 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr)
/* Build a destination descriptor, using the pointer, source, as the
data field. */
gfc_trans_create_temp_array (&se->pre, &se->post, se->ss, mold_type,
- NULL_TREE, false, true, false, &expr->where);
+ NULL_TREE, false, true, false, &expr->where,
+ true);
/* Cast the pointer to the result. */
tmp = gfc_conv_descriptor_data_get (info->descriptor);
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 71e911f8c9ee..53237a34f0ba 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -325,7 +325,7 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se *
loopse,
gfc_init_block (&temp_post);
tmp = gfc_trans_create_temp_array (&se->pre, &temp_post, tmp_ss,
temptype, initial, false, true,
- false, &arg->expr->where);
+ false, &arg->expr->where, true);
gfc_add_modify (&se->pre, size, tmp);
tmp = fold_convert (pvoid_type_node, tmp_ss->info->data.array.data);
gfc_add_modify (&se->pre, data, tmp);
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 9f58036eb09b..955ac9aa113e 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -286,6 +286,7 @@ typedef struct gfc_ss_info
struct
{
tree type;
+ unsigned preserve_bounds:1;
}
temp;
