Dear All,
Andre put me to shame with a devastatingly simple replacement for a
horribly complicated and wrong patch that I was getting into.
The part of the patch in trans-expr.c fixes the PR and the part in
trans-stmt.c fixes a memory leak in function 'tt'. This latter fixes
half of the memory leaks in class_array_15.f03. I have noted the rest
of this problem in PR38319 with which it is associated.
Bootstraps and regtests on FC21/x86_64 - OK for trunk and, later
5-branch and 6-branch?
Cheers
Paul
2016-11-24 Andre Vehreschild <ve...@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.
2016-11-24 Paul Thomas <pa...@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.
Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c (revision 242620)
--- gcc/fortran/trans-expr.c (working copy)
*************** gfc_conv_procedure_call (gfc_se * se, gf
*** 5568,5574 ****
tmp = gfc_deallocate_alloc_comp (e->ts.u.derived, tmp, parm_rank);
! gfc_add_expr_to_block (&se->post, tmp);
}
/* Add argument checking of passing an unallocated/NULL actual to
--- 5568,5574 ----
tmp = gfc_deallocate_alloc_comp (e->ts.u.derived, tmp, parm_rank);
! gfc_prepend_expr_to_block (&post, tmp);
}
/* Add argument checking of passing an unallocated/NULL actual to
Index: gcc/fortran/trans-stmt.c
===================================================================
*** gcc/fortran/trans-stmt.c (revision 242620)
--- gcc/fortran/trans-stmt.c (working copy)
*************** gfc_trans_allocate (gfc_code * code)
*** 5684,5700 ****
}
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. */
--- 5684,5689 ----
*************** gfc_trans_allocate (gfc_code * code)
*** 5705,5710 ****
--- 5694,5712 ----
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 ?
Index: gcc/testsuite/gfortran.dg/allocatable_function_10.f90
===================================================================
*** gcc/testsuite/gfortran.dg/allocatable_function_10.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/allocatable_function_10.f90 (working copy)
***************
*** 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 <abenso...@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
Index: gcc/testsuite/gfortran.dg/class_array_15.f03
===================================================================
*** gcc/testsuite/gfortran.dg/class_array_15.f03 (revision 242620)
--- gcc/testsuite/gfortran.dg/class_array_15.f03 (working copy)
*************** subroutine pr54992 ! This test remains
*** 115,118 ****
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" } }
--- 115,118 ----
bh => bhGet(b,instance=2)
if (loc (b) .ne. loc(bh%hostNode)) call abort
end
! ! { dg-final { scan-tree-dump-times "builtin_free" 12 "original" } }
