https://gcc.gnu.org/g:6801bc9fd42d2c81be1483e56dfed84c9a797746
commit 6801bc9fd42d2c81be1483e56dfed84c9a797746
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 | 6 ++-
gcc/fortran/trans-stmt.cc | 2 +-
gcc/fortran/trans.h | 1 +
6 files changed, 64 insertions(+), 39 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index a5c14886511c..8e1fef6b301f 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1910,17 +1910,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);
}
@@ -3666,9 +3669,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;
@@ -3694,13 +3699,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);
}
}
@@ -3710,7 +3717,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);
}
@@ -3735,7 +3742,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;
@@ -3822,19 +3830,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
@@ -3995,13 +4006,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)
@@ -4011,7 +4027,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);
}
}
@@ -4039,9 +4055,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;
@@ -5319,7 +5335,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;
@@ -8215,6 +8232,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
@@ -8229,7 +8248,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 153b6f4d2800..0c7547d7a5b6 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -5450,6 +5450,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;
@@ -8390,7 +8391,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;
@@ -8426,7 +8427,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 5bd023192cb1..b2fc6d4869a3 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -1283,7 +1283,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)
@@ -8760,7 +8761,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 2a6cd00be5cc..9ef699ee29dd 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 28f81578e591..17a882d16dd2 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;
