Hello world,
the attached patch fixes a 7/8/9 regression where a spurious warning
about compiler-generated variables, with allocation on stat.
The rest of the PR (ALLOCATE in an IF statememnt, later use
of the array) is a dup of PR 66459, which has now been reclassified
as a middle-end bug.
If I get this part committed, I intend to resolve 67679 as a duplicate
of 66459.
Regression-tested. OK for trunk?
Regards
Thomas
2019-02-03 Thomas Koenig <tkoe...@gcc.gnu.org>
PR fortran/67679
* trans-array.c (gfc_array_allocate): For setting the bounds on
the new array, add a condition for a not previously allocated
variable.
2019-02-03 Thomas Koenig <tkoe...@gcc.gnu.org>
PR fortran/67679
* gfortran.dg/warn_undefined_1.f90: New test.
* gfortran.dg/coarray_lock_7.f90: Fix patterns in test.
Index: fortran/trans-array.c
===================================================================
--- fortran/trans-array.c (Revision 268432)
+++ fortran/trans-array.c (Arbeitskopie)
@@ -5736,6 +5736,7 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr,
tree var_overflow = NULL_TREE;
tree cond;
tree set_descriptor;
+ tree not_prev_allocated = NULL_TREE;
stmtblock_t set_descriptor_block;
stmtblock_t elseblock;
gfc_expr **lower;
@@ -5881,8 +5882,6 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr,
}
}
- gfc_start_block (&elseblock);
-
/* Allocate memory to store the data. */
if (POINTER_TYPE_P (TREE_TYPE (se->expr)))
se->expr = build_fold_indirect_ref_loc (input_location, se->expr);
@@ -5898,6 +5897,19 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr,
pointer = gfc_conv_descriptor_data_get (se->expr);
STRIP_NOPS (pointer);
+ if (allocatable)
+ {
+ not_prev_allocated = gfc_create_var (logical_type_node,
+ "not_prev_allocated");
+ tmp = fold_build2_loc (input_location, EQ_EXPR,
+ logical_type_node, pointer,
+ build_int_cst (TREE_TYPE (pointer), 0));
+
+ gfc_add_modify (&se->pre, not_prev_allocated, tmp);
+ }
+
+ gfc_start_block (&elseblock);
+
/* The allocatable variant takes the old pointer as first argument. */
if (allocatable)
gfc_allocate_allocatable (&elseblock, pointer, size, token,
@@ -5965,6 +5977,11 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr,
cond = fold_build2_loc (input_location, EQ_EXPR,
logical_type_node, status,
build_int_cst (TREE_TYPE (status), 0));
+
+ if (not_prev_allocated != NULL_TREE)
+ cond = fold_build2_loc (input_location, TRUTH_OR_EXPR,
+ logical_type_node, cond, not_prev_allocated);
+
gfc_add_expr_to_block (&se->pre,
fold_build3_loc (input_location, COND_EXPR, void_type_node,
cond,
Index: testsuite/gfortran.dg/coarray_lock_7.f90
===================================================================
--- testsuite/gfortran.dg/coarray_lock_7.f90 (Revision 268432)
+++ testsuite/gfortran.dg/coarray_lock_7.f90 (Arbeitskopie)
@@ -35,8 +35,8 @@ end
! { dg-final { scan-tree-dump-times "_gfortran_caf_lock \\(caf_token.., 0, 0, 0B, 0B, 0B, 0\\);" 1 "original" } }
! { dg-final { scan-tree-dump-times "_gfortran_caf_unlock \\(caf_token.., 0, 0, 0B, 0B, 0\\);" 1 "original" } }
-! { dg-final { scan-tree-dump-times "_gfortran_caf_lock \\(caf_token.., .*\\(\\(3 - parm...dim\\\[0\\\].lbound\\) \\+ \\(MAX_EXPR <parm...dim\\\[0\\\].ubound - parm...dim\\\[0\\\].lbound, -1> \\+ 1\\) \\* \\(3 - parm...dim\\\[1\\\].lbound\\)\\), 0, 0B, &ii, 0B, 0\\);|_gfortran_caf_lock \\(caf_token.1, \\(3 - parm...dim\\\[0\\\].lbound\\) \\+ \\(MAX_EXPR <parm...dim\\\[0\\\].ubound - parm...dim\\\[0\\\].lbound, -1> \\+ 1\\) \\* \\(3 - parm...dim\\\[1\\\].lbound\\), 0, 0B, &ii, 0B, 0\\);" 1 "original" } }
-! { dg-final { scan-tree-dump-times "_gfortran_caf_unlock \\(caf_token.., .*\\(\\(2 - parm...dim\\\[0\\\].lbound\\) \\+ \\(MAX_EXPR <parm...dim\\\[0\\\].ubound - parm...dim\\\[0\\\].lbound, -1> \\+ 1\\) \\* \\(3 - parm...dim\\\[1\\\].lbound\\)\\), 0, &ii, 0B, 0\\);|_gfortran_caf_unlock \\(caf_token.., \\(2 - parm...dim\\\[0\\\].lbound\\) \\+ \\(MAX_EXPR <parm...dim\\\[0\\\].ubound - parm...dim\\\[0\\\].lbound, -1> \\+ 1\\) \\* \\(3 - parm...dim\\\[1\\\].lbound\\), 0, &ii, 0B, 0\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_lock \\(caf_token.., .*\\(\\(3 - parm....dim\\\[0\\\].lbound\\) \\+ \\(MAX_EXPR <parm....dim\\\[0\\\].ubound - parm....dim\\\[0\\\].lbound, -1> \\+ 1\\) \\* \\(3 - parm....dim\\\[1\\\].lbound\\)\\), 0, 0B, &ii, 0B, 0\\);|_gfortran_caf_lock \\(caf_token.1, \\(3 - parm....dim\\\[0\\\].lbound\\) \\+ \\(MAX_EXPR <parm....dim\\\[0\\\].ubound - parm....dim\\\[0\\\].lbound, -1> \\+ 1\\) \\* \\(3 - parm....dim\\\[1\\\].lbound\\), 0, 0B, &ii, 0B, 0\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_unlock \\(caf_token.., .*\\(\\(2 - parm....dim\\\[0\\\].lbound\\) \\+ \\(MAX_EXPR <parm....dim\\\[0\\\].ubound - parm....dim\\\[0\\\].lbound, -1> \\+ 1\\) \\* \\(3 - parm....dim\\\[1\\\].lbound\\)\\), 0, &ii, 0B, 0\\);|_gfortran_caf_unlock \\(caf_token.., \\(2 - parm....dim\\\[0\\\].lbound\\) \\+ \\(MAX_EXPR <parm....dim\\\[0\\\].ubound - parm....dim\\\[0\\\].lbound, -1> \\+ 1\\) \\* \\(3 - parm....dim\\\[1\\\].lbound\\), 0, &ii, 0B, 0\\);" 1 "original" } }
! { dg-final { scan-tree-dump-times "_gfortran_caf_lock \\(three.token, 0, \\(integer\\(kind=4\\)\\) \\(5 - three.dim\\\[0\\\].lbound\\), &acquired.\[0-9\]+, 0B, 0B, 0\\);|_gfortran_caf_lock \\(three.token, 0, 5 - three.dim\\\[0\\\].lbound, &acquired.\[0-9\]+, 0B, 0B, 0\\);" 1 "original" } }
! { dg-final { scan-tree-dump-times "_gfortran_caf_unlock \\(three.token, 0, \\(integer\\(kind=4\\)\\) \\(8 - three.dim\\\[0\\\].lbound\\), &ii, 0B, 0\\);|_gfortran_caf_unlock \\(three.token, 0, 8 - three.dim\\\[0\\\].lbound, &ii, 0B, 0\\);" 1 "original" } }
! { dg-do compile }
! { dg-options "-O2 -Wuninitialized" }
! PR 67679 - this used to cause an undefined warning for
! variables generated by the compiler.
subroutine s(h, Gmin, r)
implicit none
real, intent(in) :: Gmin(3), h(3)
integer, intent(inout) :: r
integer :: x_min(3), x_max(3), k, iStat
logical, dimension(:), allocatable :: check
do k = 1,1
x_min(k) = int(Gmin(k)*h(k))
x_max(k) = int(Gmin(k)*h(k))
end do
allocate(check(x_min(1):x_max(1)),stat=iStat)
check(:) = .false.
do k = x_min(1),x_max(1)
r = r + 1
end do
end
