https://gcc.gnu.org/g:662b288e5611f8bdd2c08f84145407b1b4322043
commit 662b288e5611f8bdd2c08f84145407b1b4322043
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Wed Jul 9 09:40:32 2025 +0200
Revert "Revert ajout code mort"
This reverts commit b21e21bc0588147b01fa9b84606a6c720288170b.
Suppression warning
Ajout espace commentaire
Diff:
---
gcc/fortran/gfortran.h | 4 ---
gcc/fortran/trans-array.cc | 84 ++++++++++++++++++++++------------------------
2 files changed, 40 insertions(+), 48 deletions(-)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 6848bd1762d3..69367e638c5b 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2028,10 +2028,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 b6b11952381c..d57f1d7dff06 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -6800,8 +6800,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;
}
@@ -11415,7 +11413,6 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo
*loop,
stmtblock_t alloc_block;
stmtblock_t fblock;
stmtblock_t loop_pre_block;
- gfc_ref *ref;
gfc_ss *rss;
gfc_ss *lss;
gfc_array_info *linfo;
@@ -11495,14 +11492,52 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo
*loop,
&& !expr2->value.function.isym)
expr2->ts.u.cl->backend_decl = rss->info->string_length;
- gfc_start_block (&fblock);
-
/* Since the lhs is allocatable, this must be a descriptor type.
Get the data and array size. */
desc = linfo->descriptor;
gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)));
array1 = gfc_conv_descriptor_data_get (desc);
+ /* If the data is null, set the descriptor bounds and offset. This
suppresses
+ the maybe used uninitialized warning and forces the use of malloc because
+ the size is zero in all dimensions. */
+
+ stmtblock_t unalloc_init_block;
+ gfc_init_block (&unalloc_init_block);
+ tree guard = gfc_create_var (logical_type_node, "unallocated_init_guard");
+ gfc_add_modify (&unalloc_init_block, guard, logical_false_node);
+
+ 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);
+ }
+
+ tmp = gfc_conv_descriptor_offset (desc);
+ gfc_add_modify (&loop_pre_block, tmp, gfc_index_zero_node);
+
+ tmp = fold_build2_loc (input_location, EQ_EXPR,
+ logical_type_node, array1,
+ build_int_cst (TREE_TYPE (array1), 0));
+ tmp = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
+ logical_type_node, tmp, guard);
+ 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);
+ gfc_prepend_expr_to_block (&loop->pre,
+ gfc_finish_block (&unalloc_init_block));
+
+ gfc_start_block (&fblock);
+
if (expr2)
desc2 = rss->info->data.array.descriptor;
else
@@ -11615,45 +11650,6 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo
*loop,
array1, build_int_cst (TREE_TYPE (array1), 0));
cond_null= gfc_evaluate_now (cond_null, &fblock);
- /* If the data is null, set the descriptor bounds and offset. This suppresses
- the maybe used uninitialized warning and forces the use of malloc because
- the size is zero in all dimensions. Note that this block is only executed
- if the lhs is unallocated and is only applied once in any namespace.
- Component references are not subject to the warnings. */
- for (ref = expr1->ref; ref; ref = ref->next)
- 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);
- }
-
- tmp = gfc_conv_descriptor_offset (desc);
- gfc_add_modify (&loop_pre_block, tmp, 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));
