re PR fortran/31320 (Illegal read with gfortran.dg/alloc_comp_assign_2.f90 and *_3.f90)

2007-07-17  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/31320
	PR fortran/32665
	* trans-expr.c (gfc_trans_subcomponent_assign): Ensure that
	renormalization unity base is done independently of existing
	lbound value.
	(gfc_trans_scalar_assign): If rhs is not a variable, put
	lse->pre after rse->pre to ensure that de-allocation of lhs
	occurs after evaluation of rhs.

2007-07-17  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/31320
	PR fortran/32665
	* gfortran.dg/alloc_comp_constructor_3.f90: New test.

From-SVN: r126703

4 files changed, 85 insertions, 41 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index f88667c..726fd18 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,14 @@
+2007-07-17  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/31320
+	PR fortran/32665
+	* trans-expr.c (gfc_trans_subcomponent_assign): Ensure that
+	renormalization unity base is done independently of existing
+	lbound value.
+	(gfc_trans_scalar_assign): If rhs is not a variable, put
+	lse->pre after rse->pre to ensure that de-allocation of lhs
+	occurs after evaluation of rhs.
+
 2007-07-16  Lee Millward  <lee.millward@gmail.com>
 
 	PR fortran/32222
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index e1a3a8c..fce6159 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -2973,65 +2973,68 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr)
       if (cm->allocatable && expr->expr_type == EXPR_NULL)
  	gfc_conv_descriptor_data_set (&block, dest, null_pointer_node);
       else if (cm->allocatable)
-        {
-          tree tmp2;
+	{
+	  tree tmp2;
 
           gfc_init_se (&se, NULL);
  
 	  rss = gfc_walk_expr (expr);
-          se.want_pointer = 0;
-          gfc_conv_expr_descriptor (&se, expr, rss);
+	  se.want_pointer = 0;
+	  gfc_conv_expr_descriptor (&se, expr, rss);
 	  gfc_add_block_to_block (&block, &se.pre);
 
 	  tmp = fold_convert (TREE_TYPE (dest), se.expr);
 	  gfc_add_modify_expr (&block, dest, tmp);
 
-          if (cm->ts.type == BT_DERIVED && cm->ts.derived->attr.alloc_comp)
+	  if (cm->ts.type == BT_DERIVED && cm->ts.derived->attr.alloc_comp)
 	    tmp = gfc_copy_alloc_comp (cm->ts.derived, se.expr, dest,
 				       cm->as->rank);
 	  else
-            tmp = gfc_duplicate_allocatable (dest, se.expr,
+	    tmp = gfc_duplicate_allocatable (dest, se.expr,
 					     TREE_TYPE(cm->backend_decl),
 					     cm->as->rank);
 
-          gfc_add_expr_to_block (&block, tmp);
-
-          gfc_add_block_to_block (&block, &se.post);
-          gfc_conv_descriptor_data_set (&block, se.expr, null_pointer_node);
+	  gfc_add_expr_to_block (&block, tmp);
 
-          /* Shift the lbound and ubound of temporaries to being unity, rather
-             than zero, based.  Calculate the offset for all cases.  */
-          offset = gfc_conv_descriptor_offset (dest);
-          gfc_add_modify_expr (&block, offset, gfc_index_zero_node);
-          tmp2 =gfc_create_var (gfc_array_index_type, NULL);
-          for (n = 0; n < expr->rank; n++)
-            {
-              if (expr->expr_type != EXPR_VARIABLE
-                  && expr->expr_type != EXPR_CONSTANT)
-                {
-                  tmp = gfc_conv_descriptor_ubound (dest, gfc_rank_cst[n]);
-                  gfc_add_modify_expr (&block, tmp,
-                                       fold_build2 (PLUS_EXPR,
-				      		    gfc_array_index_type,
-                                                    tmp, gfc_index_one_node));
-                  tmp = gfc_conv_descriptor_lbound (dest, gfc_rank_cst[n]);
-                  gfc_add_modify_expr (&block, tmp, gfc_index_one_node);
-                }
-              tmp = fold_build2 (MULT_EXPR, gfc_array_index_type,
-                                 gfc_conv_descriptor_lbound (dest,
+	  gfc_add_block_to_block (&block, &se.post);
+	  gfc_conv_descriptor_data_set (&block, se.expr, null_pointer_node);
+
+	  /* Shift the lbound and ubound of temporaries to being unity, rather
+	     than zero, based.  Calculate the offset for all cases.  */
+	  offset = gfc_conv_descriptor_offset (dest);
+	  gfc_add_modify_expr (&block, offset, gfc_index_zero_node);
+	  tmp2 =gfc_create_var (gfc_array_index_type, NULL);
+	  for (n = 0; n < expr->rank; n++)
+	    {
+	      if (expr->expr_type != EXPR_VARIABLE
+		    && expr->expr_type != EXPR_CONSTANT)
+		{
+		  tree span;
+		  tmp = gfc_conv_descriptor_ubound (dest, gfc_rank_cst[n]);
+		  span = fold_build2 (MINUS_EXPR, gfc_array_index_type, tmp,
+			    gfc_conv_descriptor_lbound (dest, gfc_rank_cst[n]));
+		  gfc_add_modify_expr (&block, tmp,
+				       fold_build2 (PLUS_EXPR,
+						    gfc_array_index_type,
+						    span, gfc_index_one_node));
+		  tmp = gfc_conv_descriptor_lbound (dest, gfc_rank_cst[n]);
+		  gfc_add_modify_expr (&block, tmp, gfc_index_one_node);
+		}
+	      tmp = fold_build2 (MULT_EXPR, gfc_array_index_type,
+				 gfc_conv_descriptor_lbound (dest,
 							     gfc_rank_cst[n]),
-                                 gfc_conv_descriptor_stride (dest,
+				 gfc_conv_descriptor_stride (dest,
 							     gfc_rank_cst[n]));
-              gfc_add_modify_expr (&block, tmp2, tmp);
-              tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, offset, tmp2);
-              gfc_add_modify_expr (&block, offset, tmp);
-            }
-        }
+	      gfc_add_modify_expr (&block, tmp2, tmp);
+	      tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, offset, tmp2);
+	      gfc_add_modify_expr (&block, offset, tmp);
+	    }
+	}
       else
-        {
+	{
 	  tmp = gfc_trans_subarray_assign (dest, cm, expr);
 	  gfc_add_expr_to_block (&block, tmp);
-        }
+	}
     }
   else if (expr->ts.type == BT_DERIVED)
     {
@@ -3497,9 +3500,17 @@ gfc_trans_scalar_assign (gfc_se * lse, gfc_se * rse, gfc_typespec ts,
 	    tmp = build3_v (COND_EXPR, cond, build_empty_stmt (), tmp);
 	  gfc_add_expr_to_block (&lse->pre, tmp);
 	}
-	
-      gfc_add_block_to_block (&block, &lse->pre);
-      gfc_add_block_to_block (&block, &rse->pre);
+
+      if (r_is_var)
+	{
+	  gfc_add_block_to_block (&block, &lse->pre);
+	  gfc_add_block_to_block (&block, &rse->pre);
+	}
+      else
+	{
+	  gfc_add_block_to_block (&block, &rse->pre);
+	  gfc_add_block_to_block (&block, &lse->pre);
+	}
 
       gfc_add_modify_expr (&block, lse->expr,
 			   fold_convert (TREE_TYPE (lse->expr), rse->expr));
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index cb17867..ec808de 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2007-07-17  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/31320
+	PR fortran/32665
+	* gfortran.dg/alloc_comp_constructor_3.f90: New test.
+
 2007-07-17  Zdenek Dvorak  <dvorakz@suse.cz>
 
 	PR rtl-optimization/32773
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_constructor_3.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_constructor_3.f90
new file mode 100644
index 0000000..53fa79c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_constructor_3.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! Tests the fix for PR32665 in which the structure initializer at line
+! 13 was getting the array length wrong by one and in which the automatic
+! deallocation of a in 14 was occurring before the evaluation of the rhs.
+!
+! Contributed by Daniel Franke <dfranke@gcc.gnu.org>
+!
+  TYPE :: x
+    INTEGER, ALLOCATABLE :: a(:)
+  END TYPE
+  TYPE(x) :: a
+
+  a = x ((/ 1, 2, 3 /))                             ! This is also pr31320.
+  a = x ((/ a%a, 4 /))
+  if (any (a%a .ne. (/1,2,3,4/))) call abort ()
+end