Hello,
this is about PR61831 where in code like:
type :: string_t
character(LEN=1), dimension(:), allocatable :: chars
end type string_t
type(string_t) :: prt_in
(...)
tmp = new_prt_spec ([prt_in])
the deallocation of the argument's allocatable components after the
procedure call (to new_prt_spec) has the side effect of freeing prt_in's
allocatable components, as the array constructor temporary for [prt_in]
is a shallow copy of prt_in.
This bug is a regression caused by the Dominique's PR41936 memory leak
fix, itself based on a patch originally from me.
The attached patch is basically a revert of that fix. It avoids the
problem by not deallocating allocatable components in the problematic
case, at the price of a (possible) memory leak. A new function is
introduced telling whether there is aliasing, so that we don't regress
on PR41936's memory leak when there is no aliasing, and we don't free
components when there is aliasing.
The possible remaining memory leak case is the case of a "mixed" array
constructor with some parts aliasing variables, and some non-aliasing parts.
The patch takes also the opportunity to reassemble the scattered
procedure argument deallocation code into a single place.
The test needs pr65792's fix (thanks Paul), so for the 4.9 branch I
propose commenting the parts that depend on PR65792 in the test.
Regression tested on x86_64-linux. OK for 6/5/4.9 ?
Mikael
2015-05-16 Mikael Morin <mik...@gcc.gnu.org>
PR fortran/61831
* trans-array.c (gfc_conv_array_parameter): Remove allocatable
component deallocation code generation.
* trans-expr.c (gfc_conv_expr_reference): Ditto.
(expr_may_alias_variables): New function.
(gfc_conv_procedure_call): Use it to decide whether generate
allocatable component deallocation code.
(gfc_trans_subarray_assign): Set deep copy flag.
2015-05-16 Mikael Morin <mik...@gcc.gnu.org>
PR fortran/61831
* gfortran.dg/derived_constructor_components_6.f90: New.
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 8267f6a..210b2ec 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -7305,19 +7305,6 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
expr, size);
}
- /* Deallocate the allocatable components of structures that are
- not variable. */
- if ((expr->ts.type == BT_DERIVED || expr->ts.type == BT_CLASS)
- && expr->ts.u.derived->attr.alloc_comp
- && expr->expr_type != EXPR_VARIABLE)
- {
- tmp = build_fold_indirect_ref_loc (input_location, se->expr);
- tmp = gfc_deallocate_alloc_comp (expr->ts.u.derived, tmp, expr->rank);
-
- /* The components shall be deallocated before their containing entity. */
- gfc_prepend_expr_to_block (&se->post, tmp);
- }
-
if (g77 || (fsym && fsym->attr.contiguous
&& !gfc_is_simply_contiguous (expr, false)))
{
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 9be8a42..e375453 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -4536,6 +4536,36 @@ conv_arglist_function (gfc_se *se, gfc_expr *expr, const char *name)
}
+/* Temporary arrays generated to represent array constructors are made
+ using simple copies, so that their elements may alias some variable
+ they were copied from.
+ This function tells whether the expression given as input may alias
+ some other variable, under the assumption that only variables and array
+ constructor may alias (in particular structure constructors don't alias),
+ and array constructor elements alias iff they are copied from a variable.
+ This function is used to decide whether freeing an expression's allocatable
+ components is safe or should be avoided. */
+
+static bool
+expr_may_alias_variables (gfc_expr *e)
+{
+ gfc_constructor *c;
+
+ if (e->expr_type == EXPR_VARIABLE)
+ return true;
+ else if (e->expr_type != EXPR_ARRAY)
+ return false;
+
+ for (c = gfc_constructor_first (e->value.constructor);
+ c; c = gfc_constructor_next (c))
+ if (c->expr
+ && expr_may_alias_variables (c->expr))
+ return true;
+
+ return false;
+}
+
+
/* Generate code for a procedure call. Note can return se->post != NULL.
If se->direct_byref is set then se->expr contains the return parameter.
Return nonzero, if the call has alternate specifiers.
@@ -5328,7 +5358,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
if (e && (e->ts.type == BT_DERIVED || e->ts.type == BT_CLASS)
&& e->ts.u.derived->attr.alloc_comp
&& !(e->symtree && e->symtree->n.sym->attr.pointer)
- && (e->expr_type != EXPR_VARIABLE && !e->rank))
+ && !expr_may_alias_variables (e))
{
int parm_rank;
tmp = build_fold_indirect_ref_loc (input_location,
@@ -6642,7 +6672,7 @@ gfc_trans_subarray_assign (tree dest, gfc_component * cm, gfc_expr * expr)
gfc_conv_expr (&rse, expr);
- tmp = gfc_trans_scalar_assign (&lse, &rse, cm->ts, true, false, true);
+ tmp = gfc_trans_scalar_assign (&lse, &rse, cm->ts, true, true, true);
gfc_add_expr_to_block (&body, tmp);
gcc_assert (rse.ss == gfc_ss_terminator);
@@ -7513,20 +7543,6 @@ gfc_conv_expr_reference (gfc_se * se, gfc_expr * expr)
/* Take the address of that value. */
se->expr = gfc_build_addr_expr (NULL_TREE, var);
- if (expr->ts.type == BT_DERIVED && expr->rank
- && !gfc_is_finalizable (expr->ts.u.derived, NULL)
- && expr->ts.u.derived->attr.alloc_comp
- && expr->expr_type != EXPR_VARIABLE)
- {
- tree tmp;
-
- tmp = build_fold_indirect_ref_loc (input_location, se->expr);
- tmp = gfc_deallocate_alloc_comp (expr->ts.u.derived, tmp, expr->rank);
-
- /* The components shall be deallocated before
- their containing entity. */
- gfc_prepend_expr_to_block (&se->post, tmp);
- }
}
! { dg-do run }
! { dg-additional-options "-fsanitize=address -fdump-tree-original"
!
! PR fortran/61831
! The deallocation of components of array constructor elements
! used to have the side effect of also deallocating some other
! variable's components from which they were copied.
program main
implicit none
integer, parameter :: n = 2
type :: string_t
character(LEN=1), dimension(:), allocatable :: chars
end type string_t
type :: string_container_t
type(string_t) :: comp
end type string_container_t
type :: string_array_container_t
type(string_t) :: comp(n)
end type string_array_container_t
type(string_t) :: prt_in, tmp, tmpa(n)
type(string_container_t) :: tmpc, tmpca(n)
type(string_array_container_t) :: tmpac, tmpaca(n)
integer :: i, j, k
do i=1,16
! Test without intermediary function
prt_in = string_t(["A"])
if (.not. allocated(prt_in%chars)) call abort
if (any(prt_in%chars .ne. "A")) call abort
deallocate (prt_in%chars)
! scalar elemental function
prt_in = string_t(["B"])
if (.not. allocated(prt_in%chars)) call abort
if (any(prt_in%chars .ne. "B")) call abort
tmp = new_prt_spec (prt_in)
if (.not. allocated(prt_in%chars)) call abort
if (any(prt_in%chars .ne. "B")) call abort
deallocate (prt_in%chars)
deallocate (tmp%chars)
! array elemental function with array constructor
prt_in = string_t(["C"])
if (.not. allocated(prt_in%chars)) call abort
if (any(prt_in%chars .ne. "C")) call abort
tmpa = new_prt_spec ([(prt_in, i=1,2)])
if (.not. allocated(prt_in%chars)) call abort
if (any(prt_in%chars .ne. "C")) call abort
deallocate (prt_in%chars)
do j=1,n
deallocate (tmpa(j)%chars)
end do
! scalar elemental function with structure constructor
prt_in = string_t(["D"])
if (.not. allocated(prt_in%chars)) call abort
if (any(prt_in%chars .ne. "D")) call abort
tmpc = new_prt_spec2 (string_container_t(prt_in))
if (.not. allocated(prt_in%chars)) call abort
if (any(prt_in%chars .ne. "D")) call abort
deallocate (prt_in%chars)
deallocate(tmpc%comp%chars)
! array elemental function of an array constructor of structure constructors
prt_in = string_t(["E"])
if (.not. allocated(prt_in%chars)) call abort
if (any(prt_in%chars .ne. "E")) call abort
tmpca = new_prt_spec2 ([ (string_container_t(prt_in), i=1,2) ])
if (.not. allocated(prt_in%chars)) call abort
if (any(prt_in%chars .ne. "E")) call abort
deallocate (prt_in%chars)
do j=1,n
deallocate (tmpca(j)%comp%chars)
end do
! scalar elemental function with a structure constructor and a nested array constructor
prt_in = string_t(["F"])
if (.not. allocated(prt_in%chars)) call abort
if (any(prt_in%chars .ne. "F")) call abort
tmpac = new_prt_spec3 (string_array_container_t([ (prt_in, i=1,2) ]))
if (.not. allocated(prt_in%chars)) call abort
if (any(prt_in%chars .ne. "F")) call abort
deallocate (prt_in%chars)
do j=1,n
deallocate (tmpac%comp(j)%chars)
end do
! array elemental function with an array constructor nested inside
! a structure constructor nested inside an array constructor
prt_in = string_t(["G"])
if (.not. allocated(prt_in%chars)) call abort
if (any(prt_in%chars .ne. "G")) call abort
tmpaca = new_prt_spec3 ([ (string_array_container_t([ (prt_in, i=1,2) ]), j=1,2) ])
if (.not. allocated(prt_in%chars)) call abort
if (any(prt_in%chars .ne. "G")) call abort
deallocate (prt_in%chars)
do j=1,n
do k=1,n
deallocate (tmpaca(j)%comp(k)%chars)
end do
end do
end do
contains
elemental function new_prt_spec (name) result (prt_spec)
type(string_t), intent(in) :: name
type(string_t) :: prt_spec
prt_spec = name
end function new_prt_spec
elemental function new_prt_spec2 (name) result (prt_spec)
type(string_container_t), intent(in) :: name
type(string_container_t) :: prt_spec
prt_spec = name
end function new_prt_spec2
elemental function new_prt_spec3 (name) result (prt_spec)
type(string_array_container_t), intent(in) :: name
type(string_array_container_t) :: prt_spec
prt_spec = name
end function new_prt_spec3
end program main
! { dg-final { scan-tree-dump-times "__builtin_malloc" 15 "original" } }
! { dg-final { scan-tree-dump-times "__builtin_free" 33 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
