diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/trans-expr.c | 27 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/pr96312.f90 | 30 |
2 files changed, 51 insertions, 6 deletions
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index b7c568e..36ff9b5 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -9936,6 +9936,8 @@ fcncall_realloc_result (gfc_se *se, int rank) tree tmp; tree offset; tree zero_cond; + tree not_same_shape; + stmtblock_t shape_block; int n; /* Use the allocation done by the library. Substitute the lhs @@ -9965,7 +9967,11 @@ fcncall_realloc_result (gfc_se *se, int rank) tmp = gfc_conv_descriptor_data_get (res_desc); gfc_conv_descriptor_data_set (&se->post, desc, tmp); - /* Check that the shapes are the same between lhs and expression. */ + /* Check that the shapes are the same between lhs and expression. + The evaluation of the shape is done in 'shape_block' to avoid + unitialized warnings from the lhs bounds. */ + not_same_shape = boolean_false_node; + gfc_start_block (&shape_block); for (n = 0 ; n < rank; n++) { tree tmp1; @@ -9982,15 +9988,24 @@ fcncall_realloc_result (gfc_se *se, int rank) tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node, tmp, gfc_index_zero_node); - tmp = gfc_evaluate_now (tmp, &se->post); - zero_cond = fold_build2_loc (input_location, TRUTH_OR_EXPR, - logical_type_node, tmp, - zero_cond); + tmp = gfc_evaluate_now (tmp, &shape_block); + if (n == 0) + not_same_shape = tmp; + else + not_same_shape = fold_build2_loc (input_location, TRUTH_OR_EXPR, + logical_type_node, tmp, + not_same_shape); } /* 'zero_cond' being true is equal to lhs not being allocated or the shapes being different. */ - zero_cond = gfc_evaluate_now (zero_cond, &se->post); + tmp = fold_build2_loc (input_location, TRUTH_OR_EXPR, logical_type_node, + zero_cond, not_same_shape); + gfc_add_modify (&shape_block, zero_cond, tmp); + tmp = gfc_finish_block (&shape_block); + tmp = build3_v (COND_EXPR, zero_cond, + build_empty_stmt (input_location), tmp); + gfc_add_expr_to_block (&se->post, tmp); /* Now reset the bounds returned from the function call to bounds based on the lhs lbounds, except where the lhs is not allocated or the shapes diff --git a/gcc/testsuite/gfortran.dg/pr96312.f90 b/gcc/testsuite/gfortran.dg/pr96312.f90 new file mode 100644 index 0000000..d6d8e79 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr96312.f90 @@ -0,0 +1,30 @@ +! { dg-do compile } +! { dg-options "-O1 -Wall" } +! +! PR fortran/96312. The line with the call to 'matmul' gave the warning +! ‘tmp.dim[0].lbound’ is used uninitialized in this function +! +! Contributed by Thomas Koenig <tkoenig@gcc.gnu.org> +! +module moda +contains + PURE SUBROUTINE funca(arr, sz) + REAL, ALLOCATABLE, DIMENSION(:, :), INTENT(OUT) :: arr + integer, intent(in) :: sz + allocate(arr(sz, sz)) + arr(:, :) = 0. + END SUBROUTINE +end module + +module modc + use moda, only: funca +contains + PURE SUBROUTINE funcb(oarr) + REAL, DIMENSION(:), INTENT(OUT) :: oarr + REAL, ALLOCATABLE, DIMENSION(:, :) :: arr + real, allocatable, dimension(:) :: tmp + CALL funca(arr, ubound(oarr, 1)) + tmp = matmul(transpose(arr),oarr) + oarr = tmp*1. + END SUBROUTINE funcb +end module |