re PR fortran/40850 (double free in nested types with allocatable components)

2011-02-23  Mikael Morin  <mikael@gcc.gnu.org>

	PR fortran/40850
	* trans.c (gfc_prepend_expr_to_block): New function.
	* trans.h (gfc_prepend_expr_to_block): Declare.
	* trans-array.c (gfc_conv_array_parameter): Replace
	gfc_add_expr_to_block with gfc_prepend_expr_to_block.

2011-02-23  Mikael Morin  <mikael@gcc.gnu.org>

	PR fortran/40850
	* gfortran.dg/nested_allocatables_1.f90: New.

From-SVN: r170445

6 files changed, 59 insertions, 4 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 159b1be..96c5411 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2011-02-23  Mikael Morin  <mikael@gcc.gnu.org>
+
+	PR fortran/40850
+	* trans.c (gfc_prepend_expr_to_block): New function.
+	* trans.h (gfc_prepend_expr_to_block): Declare.
+	* trans-array.c (gfc_conv_array_parameter): Replace
+	gfc_add_expr_to_block with gfc_prepend_expr_to_block.
+
 2011-02-22  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/45743
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 4e901f2..ac08c42 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -6097,10 +6097,11 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, bool g77,
 	&& expr->ts.u.derived->attr.alloc_comp
 	&& expr->expr_type != EXPR_VARIABLE)
     {
-      tmp = build_fold_indirect_ref_loc (input_location,
-				     se->expr);
+      tmp = build_fold_indirect_ref_loc (input_location, se->expr);
       tmp = gfc_deallocate_alloc_comp (expr->ts.u.derived, tmp, expr->rank);
-      gfc_add_expr_to_block (&se->post, tmp);
+
+      /* The components shall be deallocated before their containing entity.  */
+      gfc_prepend_expr_to_block (&se->post, tmp);
     }
 
   if (g77 || (fsym && fsym->attr.contiguous
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 1fd0dc1..27a352a 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -1090,7 +1090,8 @@ add_expr_to_chain (tree* chain, tree expr, bool front)
     *chain = expr;
 }
 
-/* Add a statement to a block.  */
+
+/* Add a statement at the end of a block.  */
 
 void
 gfc_add_expr_to_block (stmtblock_t * block, tree expr)
@@ -1100,6 +1101,16 @@ gfc_add_expr_to_block (stmtblock_t * block, tree expr)
 }
 
 
+/* Add a statement at the beginning of a block.  */
+
+void
+gfc_prepend_expr_to_block (stmtblock_t * block, tree expr)
+{
+  gcc_assert (block);
+  add_expr_to_chain (&block->head, expr, true);
+}
+
+
 /* Add a block the end of a block.  */
 
 void
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 40097a9..1536f2e 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -396,6 +396,8 @@ void gfc_trans_vla_type_sizes (gfc_symbol *, stmtblock_t *);
 
 /* Add an expression to the end of a block.  */
 void gfc_add_expr_to_block (stmtblock_t *, tree);
+/* Add an expression to the beginning of a block.  */
+void gfc_prepend_expr_to_block (stmtblock_t *, tree);
 /* Add a block to the end of a block.  */
 void gfc_add_block_to_block (stmtblock_t *, stmtblock_t *);
 /* Add a MODIFY_EXPR to a block.  */
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 20e9eed..b2abbe7 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2011-02-23  Mikael Morin  <mikael@gcc.gnu.org>
+
+	PR fortran/40850
+	* gfortran.dg/nested_allocatables_1.f90: New.
+
 2011-02-23  Nathan Froyd  <froydnj@codesourcery.com>
 
 	PR c++/46868
diff --git a/gcc/testsuite/gfortran.dg/nested_allocatables_1.f90 b/gcc/testsuite/gfortran.dg/nested_allocatables_1.f90
new file mode 100644
index 0000000..607a883
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/nested_allocatables_1.f90
@@ -0,0 +1,28 @@
+! { dg-do run }
+!
+! PR fortran/40850
+! The code freeing allocatable components used to be put after the code
+! freeing the containing entity.
+!
+! Original test case by Marco Restelli <mrestelli@gmail.com>
+! Reduced by Daniel Franke <franke.daniel@gmail.com>
+!        and Janus Weil <janus@gcc.gnu.org>
+
+
+  type t
+    integer, allocatable :: d(:)
+  end type
+  type(t), allocatable :: a(:)
+
+  ! Big enough to make it fail
+  allocate(a(2 * 1024))
+  call sub( (/ a /) )
+
+contains
+
+  subroutine sub(b)
+    type(t) :: b(:)
+  end subroutine
+
+end
+