[multiple changes]

2017-11-01  Andre Vehreschild  <vehre@gcc.gnu.org>
	Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/78293
	* trans-expr.c (gfc_conv_procedure_call): Prepend deallocation
	of alloctable components to post, rather than adding to
	se->post.
	* trans-stmt.c (gfc_trans_allocate): Move deallocation of expr3
	allocatable components so that all expr3s are visited.

2017-11-01  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/78293
	* gfortran.dg/allocatable_function_10.f90: New test.
	* gfortran.dg/class_array_15.f03: Increase builtin_free count
	from 11 to 12.

From-SVN: r254319

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index da441d906e0329b34e206c7125773107c80c067c..8d75d55b25636bb3307f05fa9adaf298c464a40f 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,14 @@
+2017-11-01  Andre Vehreschild  <vehre@gcc.gnu.org>
+       Paul Thomas  <pault@gcc.gnu.org>
+
+       Backport from trunk
+       PR fortran/78293
+       * trans-expr.c (gfc_conv_procedure_call): Prepend deallocation
+       of alloctable components to post, rather than adding to
+       se->post.
+       * trans-stmt.c (gfc_trans_allocate): Move deallocation of expr3
+       allocatable components so that all expr3s are visited.
+
 2017-11-01  Paul Thomas  <pault@gcc.gnu.org>
 
        Backport from trunk

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 31146c290de5c388f69a76990c3c6de8dfd451d8..c899d639741a7d97bb5ce038bb895e20fe85e204 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -5554,7 +5554,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 
          tmp = gfc_deallocate_alloc_comp (e->ts.u.derived, tmp, parm_rank);
 
-         gfc_add_expr_to_block (&se->post, tmp);
+         gfc_prepend_expr_to_block (&post, tmp);
         }
 
       /* Add argument checking of passing an unallocated/NULL actual to

diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index dcf1769492097565f29b97e04f76f2109bebd4d9..d18e21bdc26eea27daccfcefa2e4777e9ebb0070 100644 (file)
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -5492,17 +5492,6 @@ gfc_trans_allocate (gfc_code * code)
            }
          gfc_add_modify_loc (input_location, &block, var, tmp);
 
-         /* Deallocate any allocatable components after all the allocations
-            and assignments of expr3 have been completed.  */
-         if (code->expr3->ts.type == BT_DERIVED
-             && code->expr3->rank == 0
-             && code->expr3->ts.u.derived->attr.alloc_comp)
-           {
-             tmp = gfc_deallocate_alloc_comp (code->expr3->ts.u.derived,
-                                              var, 0);
-             gfc_add_expr_to_block (&post, tmp);
-           }
-
          expr3 = var;
          if (se.string_length)
            /* Evaluate it assuming that it also is complicated like expr3.  */
@@ -5513,6 +5502,19 @@ gfc_trans_allocate (gfc_code * code)
          expr3 = se.expr;
          expr3_len = se.string_length;
        }
+
+      /* Deallocate any allocatable components after all the allocations
+        and assignments of expr3 have been completed.  */
+      if ((code->expr3->ts.type == BT_DERIVED
+          || code->expr3->ts.type == BT_CLASS)
+         && (code->expr3->expr_type != EXPR_VARIABLE || temp_var_needed)
+         && code->expr3->ts.u.derived->attr.alloc_comp)
+       {
+         tmp = gfc_deallocate_alloc_comp (code->expr3->ts.u.derived,
+                                          expr3, code->expr3->rank);
+         gfc_prepend_expr_to_block (&post, tmp);
+       }
+
       /* Store what the expr3 is to be used for.  */
       if (e3_is == E3_UNSET)
        e3_is = expr3 != NULL_TREE ?

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 22a47d9b7845b04ac9fbff67da85560b4d9c54b2..65728d7490170c451623d47cfb84ec5f3df87a0e 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,13 @@
 2017-11-01  Paul Thomas  <pault@gcc.gnu.org>
 
+       Backport from trunk
+       PR fortran/78293
+       * gfortran.dg/allocatable_function_10.f90: New test.
+       * gfortran.dg/class_array_15.f03: Increase builtin_free count
+       from 11 to 12.
+
+017-11-01  Paul Thomas  <pault@gcc.gnu.org>
+
        Backport from trunk
        PR fortran/80554
        * gfortran.dg/submodule_29.f08: New test.

diff --git a/gcc/testsuite/gfortran.dg/allocatable_function_10.f90 b/gcc/testsuite/gfortran.dg/allocatable_function_10.f90
new file mode 100644 (file)
index 0000000..8d17197
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocatable_function_10.f90
@@ -0,0 +1,46 @@
+! { dg-do run }
+!
+! Test the fix for PR78293. The deallocations are present at the
+! end of the main programme to aid memory leak searching. The
+! allocation in 'tt' leaked memory from an intermediate temporary
+! for the array constructor.
+!
+! Contributed by Andrew Benson  <abensonca@gmail.com>
+!
+module m
+  implicit none
+
+  type t
+     integer, allocatable, dimension(:) :: r
+  end type t
+
+contains
+
+  function tt(a,b)
+    implicit none
+    type(t), allocatable, dimension(:) :: tt
+    type(t), intent(in), dimension(:) :: a,b
+    allocate(tt, source = [a,b])
+  end function tt
+
+  function ts(arg)
+    implicit none
+    type(t), allocatable, dimension(:) :: ts
+    integer, intent(in) :: arg(:)
+    allocate(ts(1))
+    allocate(ts(1)%r, source = arg)
+    return
+  end function ts
+
+end module m
+
+program p
+  use m
+  implicit none
+  type(t), dimension(2) :: c
+  c=tt(ts([99,199,1999]),ts([42,142]))
+  if (any (c(1)%r .ne. [99,199,1999])) call abort
+  if (any (c(2)%r .ne. [42,142])) call abort
+  deallocate(c(1)%r)
+  deallocate(c(2)%r)
+end program p

diff --git a/gcc/testsuite/gfortran.dg/class_array_15.f03 b/gcc/testsuite/gfortran.dg/class_array_15.f03
index 85716f905cb20e7bd87abcf609d268737a762bea..fd9e04c28285fb796d1df8a48ab8ac51490bde91 100644 (file)
--- a/gcc/testsuite/gfortran.dg/class_array_15.f03
+++ b/gcc/testsuite/gfortran.dg/class_array_15.f03
@@ -115,4 +115,4 @@ subroutine pr54992  ! This test remains as the original.
   bh => bhGet(b,instance=2)
   if (loc (b) .ne. loc(bh%hostNode)) call abort
 end
-! { dg-final { scan-tree-dump-times "builtin_free" 11 "original" } }
+! { dg-final { scan-tree-dump-times "builtin_free" 12 "original" } }