https://gcc.gnu.org/g:7da3557e8d2b321d3003a9a758fa5fcfa0f4778e
commit 7da3557e8d2b321d3003a9a758fa5fcfa0f4778e
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Fri Mar 14 16:37:46 2025 +0100
Sauvegarde suppression initialisation inutile bornes pour taire warnings
Diff:
---
gcc/fortran/gfortran.h | 4 ----
gcc/fortran/trans-array.cc | 52 +++++++++++-----------------------------------
gcc/fortran/trans-expr.cc | 39 +++++++++++++++++++++++++---------
3 files changed, 41 insertions(+), 54 deletions(-)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index fb1e119f4aef..6b9c11b44f3e 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2019,10 +2019,6 @@ typedef struct gfc_symbol
/* Set if this should be passed by value, but is not a VALUE argument
according to the Fortran standard. */
unsigned pass_as_value:1;
- /* Set if an allocatable array variable has been allocated in the current
- scope. Used in the suppression of uninitialized warnings in reallocation
- on assignment. */
- unsigned allocated_in_scope:1;
/* Set if an external dummy argument is called with different argument lists.
This is legal in Fortran, but can cause problems with autogenerated
C prototypes for C23. */
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 8e1fef6b301f..fd83c6ae66a7 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -7040,13 +7040,12 @@ gfc_trans_scalarized_loop_boundary (gfc_loopinfo *
loop, stmtblock_t * body)
static void
evaluate_bound (stmtblock_t *block, tree *bounds, gfc_expr ** values,
- tree desc, int dim, bool lbound, bool deferred)
+ tree desc, int dim, bool lbound, bool deferred, bool save_value)
{
gfc_se se;
gfc_expr * input_val = values[dim];
tree *output = &bounds[dim];
-
if (input_val)
{
/* Specified section bound. */
@@ -7072,7 +7071,8 @@ evaluate_bound (stmtblock_t *block, tree *bounds,
gfc_expr ** values,
*output = lbound ? gfc_conv_array_lbound (desc, dim) :
gfc_conv_array_ubound (desc, dim);
}
- *output = gfc_evaluate_now (*output, block);
+ if (save_value)
+ *output = gfc_evaluate_now (*output, block);
}
@@ -7105,18 +7105,18 @@ gfc_conv_section_startstride (stmtblock_t * block,
gfc_ss * ss, int dim)
|| ar->dimen_type[dim] == DIMEN_THIS_IMAGE);
desc = info->descriptor;
stride = ar->stride[dim];
-
+ bool save_value = !ss->is_alloc_lhs;
/* Calculate the start of the range. For vector subscripts this will
be the range of the vector. */
evaluate_bound (block, info->start, ar->start, desc, dim, true,
- ar->as->type == AS_DEFERRED);
+ ar->as->type == AS_DEFERRED, save_value);
/* Similarly calculate the end. Although this is not used in the
scalarizer, it is needed when checking bounds and where the end
is an expression with side-effects. */
evaluate_bound (block, info->end, ar->end, desc, dim, false,
- ar->as->type == AS_DEFERRED);
+ ar->as->type == AS_DEFERRED, save_value);
/* Calculate the stride. */
@@ -7127,7 +7127,11 @@ gfc_conv_section_startstride (stmtblock_t * block,
gfc_ss * ss, int dim)
gfc_init_se (&se, NULL);
gfc_conv_expr_type (&se, stride, gfc_array_index_type);
gfc_add_block_to_block (block, &se.pre);
- info->stride[dim] = gfc_evaluate_now (se.expr, block);
+ tree value = se.expr;
+ if (save_value)
+ info->stride[dim] = gfc_evaluate_now (value, block);
+ else
+ info->stride[dim] = value;
}
}
@@ -9088,8 +9092,6 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree
status, tree errmsg,
else
gfc_add_expr_to_block (&se->pre, set_descriptor);
- expr->symtree->n.sym->allocated_in_scope = 1;
-
return true;
}
@@ -10916,7 +10918,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
gcc_assert (n == codim - 1);
evaluate_bound (&loop.pre, info->start, ar->start,
info->descriptor, n + ndim, true,
- ar->as->type == AS_DEFERRED);
+ ar->as->type == AS_DEFERRED, true);
loop.from[n + loop.dimen] = info->start[n + ndim];
}
else
@@ -13607,7 +13609,6 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo
*loop,
stmtblock_t realloc_block;
stmtblock_t alloc_block;
stmtblock_t fblock;
- stmtblock_t loop_pre_block;
gfc_ref *ref;
gfc_ss *rss;
gfc_ss *lss;
@@ -13818,35 +13819,6 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo
*loop,
if (ref->type == REF_COMPONENT)
break;
- if (!expr1->symtree->n.sym->allocated_in_scope && !ref)
- {
- gfc_start_block (&loop_pre_block);
- for (n = 0; n < expr1->rank; n++)
- {
- gfc_conv_descriptor_lbound_set (&loop_pre_block, desc,
- gfc_rank_cst[n],
- gfc_index_one_node);
- gfc_conv_descriptor_ubound_set (&loop_pre_block, desc,
- gfc_rank_cst[n],
- gfc_index_zero_node);
- gfc_conv_descriptor_stride_set (&loop_pre_block, desc,
- gfc_rank_cst[n],
- gfc_index_zero_node);
- }
-
- gfc_conv_descriptor_offset_set (&loop_pre_block, desc,
gfc_index_zero_node);
-
- tmp = fold_build2_loc (input_location, EQ_EXPR,
- logical_type_node, array1,
- build_int_cst (TREE_TYPE (array1), 0));
- tmp = build3_v (COND_EXPR, tmp,
- gfc_finish_block (&loop_pre_block),
- build_empty_stmt (input_location));
- gfc_prepend_expr_to_block (&loop->pre, tmp);
-
- expr1->symtree->n.sym->allocated_in_scope = 1;
- }
-
tmp = build3_v (COND_EXPR, cond_null,
build1_v (GOTO_EXPR, jump_label1),
build_empty_stmt (input_location));
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 0c7547d7a5b6..95060af47859 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -12642,6 +12642,35 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr *
expr2, bool init_flag,
ompws_flags |= OMPWS_SCALARIZER_WS | OMPWS_SCALARIZER_BODY;
}
+ /* F2003: Allocate or reallocate lhs of allocatable array. */
+ if (realloc_flag)
+ {
+ realloc_lhs_warning (expr1->ts.type, true, &expr1->where);
+ ompws_flags &= ~OMPWS_SCALARIZER_WS;
+ tmp = gfc_alloc_allocatable_for_assignment (&loop, expr1, expr2);
+ if (tmp != NULL_TREE)
+ gfc_add_expr_to_block (&loop.pre, tmp);
+ }
+
+ for (gfc_ss *s = loop.ss; s != gfc_ss_terminator; s = s->loop_chain)
+ {
+ if (!s->is_alloc_lhs)
+ continue;
+
+ gcc_assert (s->info->type == GFC_SS_SECTION);
+ gfc_array_info *info = &s->info->data.array;
+ info->offset = gfc_evaluate_now (info->offset, &loop.pre);
+ info->saved_offset = info->offset;
+ for (int i = 0; i < s->dimen; i++)
+ {
+ int dim = s->dim[i];
+ info->start[dim] = gfc_evaluate_now (info->start[dim], &loop.pre);
+ info->end[dim] = gfc_evaluate_now (info->end[dim], &loop.pre);
+ info->stride[dim] = gfc_evaluate_now (info->stride[dim],
&loop.pre);
+ info->delta[dim] = gfc_evaluate_now (info->delta[dim], &loop.pre);
+ }
+ }
+
/* Start the scalarized loop body. */
gfc_start_scalarized_body (&loop, &body);
}
@@ -12950,16 +12979,6 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr *
expr2, bool init_flag,
gfc_add_expr_to_block (&body, tmp);
}
- /* F2003: Allocate or reallocate lhs of allocatable array. */
- if (realloc_flag)
- {
- realloc_lhs_warning (expr1->ts.type, true, &expr1->where);
- ompws_flags &= ~OMPWS_SCALARIZER_WS;
- tmp = gfc_alloc_allocatable_for_assignment (&loop, expr1, expr2);
- if (tmp != NULL_TREE)
- gfc_add_expr_to_block (&loop.code[expr1->rank - 1], tmp);
- }
-
if (maybe_workshare)
ompws_flags &= ~OMPWS_SCALARIZER_BODY;
