Hi All, This patch is simple and well described by the ChangeLogs and the comments. Regtests OK.
OK for mainline and backporting? Cheers Paul
Change.Logs
Description: Binary data
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index ed1213a41cb..c1fb896f587 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1950,6 +1950,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 140d933e45d..aa7b90e483a 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -6580,6 +6580,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;
}
@@ -11060,6 +11062,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;
@@ -11260,6 +11264,52 @@ 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);
+
+ /* Mark so that rhs "used unallocated" warnings can be issued. Component
+ references do not generate the warnings. */
+ for (ref = expr1->ref; ref; ref = ref->next)
+ if (ref->type == REF_COMPONENT)
+ break;
+
+ if (!ref)
+ 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 00000000000..7fd4e3882a4
--- /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
