https://gcc.gnu.org/g:9906a9863d65386ee4045333eb26a2569783abb5
commit r14-10560-g9906a9863d65386ee4045333eb26a2569783abb5
Author: Paul Thomas <pa...@gcc.gnu.org>
Date: Thu Jul 18 08:51:35 2024 +0100
Fortran: Suppress bogus used uninitialized warnings [PR108889].
2024-07-18 Paul Thomas <pa...@gcc.gnu.org>
gcc/fortran
PR fortran/108889
* gfortran.h: Add bit field 'allocated_in_scope' to gfc_symbol.
* trans-array.cc (gfc_array_allocate): Set 'allocated_in_scope'
after allocation if not a component reference.
(gfc_alloc_allocatable_for_assignment): If 'allocated_in_scope'
not set, not a component ref and not allocated, set the array
bounds and offset to give zero length in all dimensions. Then
set allocated_in_scope.
gcc/testsuite/
PR fortran/108889
* gfortran.dg/pr108889.f90: New test.
(cherry picked from commit c3aa339ea50f050caf7ed2e497f5499ec2d7b9cc)
Diff:
---
gcc/fortran/gfortran.h | 4 ++++
gcc/fortran/trans-array.cc | 43 ++++++++++++++++++++++++++++++++++
gcc/testsuite/gfortran.dg/pr108889.f90 | 43 ++++++++++++++++++++++++++++++++++
3 files changed, 90 insertions(+)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index de3d9e25911b..fbdf00590bc2 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1946,6 +1946,10 @@ 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;
/* Reference counter, used for memory management.
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 761f0a425078..d5d9c730826e 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -6561,6 +6561,8 @@ 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;
}
@@ -10932,6 +10934,8 @@ 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;
gfc_array_info *linfo;
@@ -11132,6 +11136,45 @@ 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));
diff --git a/gcc/testsuite/gfortran.dg/pr108889.f90
b/gcc/testsuite/gfortran.dg/pr108889.f90
new file mode 100644
index 000000000000..7fd4e3882a48
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr108889.f90
@@ -0,0 +1,43 @@
+! { dg-do compile }
+! { dg-options "-Wall -fdump-tree-original" }
+!
+! Contributed by Tobias Burnus <bur...@gcc.gnu.org>
+!
+program main
+ implicit none
+
+ type :: struct
+ real, allocatable :: var(:)
+ end type struct
+
+ type(struct) :: single
+ real, allocatable :: ref1(:), ref2(:), ref3(:), ref4(:)
+
+ ref2 = [1,2,3,4,5] ! Warnings here
+
+ single%var = ref2 ! No warnings for components
+ ref1 = single%var ! Warnings here
+ ref1 = [1,2,3,4,5] ! Should not add to tree dump count
+
+ allocate (ref3(5))
+ ref3 = single%var ! No warnings following allocation
+
+ call set_ref4
+
+ call test (ref1)
+ call test (ref2)
+ call test (ref3)
+ call test (ref4)
+
+contains
+ subroutine test (arg)
+ real, allocatable :: arg(:)
+ if (size(arg) /= size(single%var)) stop 1
+ if (lbound(arg, 1) /= 1) stop 2
+ if (any (arg /= single%var)) stop 3
+ end
+ subroutine set_ref4
+ ref4 = single%var ! Warnings in contained scope
+ end
+end
+! { df-final { scan-tree-dump-times "ubound = 0" 3 "original" } }
\ No newline at end of file
