Hi All,

trans-expr.c(fcncall_realloc_result) unconditionally compared the shapes of
the function result and the lhs. This is clearly wrong when the lhs is not
allocated since the bounds could be used uninitialized as found by the
reporter. The patch does the obvious thing by checking the allocation
status before doing the comparison.

Regtests OK on FC31/x86_64 - OK for master?

Paul

This patch fixes PR96312. Cures a used uninitialized warning.

2020-08-9  Paul Thomas  <pa...@gcc.gnu.org>

gcc/fortran
PR fortran/96312
* trans-expr.c (fcncall_realloc_result): Only compare shapes if
lhs was allocated..

gcc/testsuite/
PR fortran/96312
* gfortran.dg/pr96312.f90: New test.
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index b7c568e90e6..36ff9b5cbc6 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
! { 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  <tkoe...@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

Reply via email to