procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add finalizer creation to array constructor for functions of derived type.

Browse source 
PR fortran/90068

gcc/fortran/ChangeLog:

	* trans-array.cc (gfc_trans_array_ctor_element): Eval non-
	variable expressions once only.
	(gfc_trans_array_constructor_value): Add statements of
	final block.
	(trans_array_constructor): Detect when final block is required.

gcc/testsuite/ChangeLog:

	* gfortran.dg/finalize_57.f90: New test.
This commit is contained in:
Andre Vehreschild 2023-07-27 14:51:34 +02:00
parent a47b1aaa7a
commit c319075648
2 changed files with 80 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
gcc/fortran/trans-array.cc
View file

@ -1885,6 +1885,16 @@ gfc_trans_array_ctor_element (stmtblock_t * pblock, tree desc,
gfc_conv_descriptor_data_get (desc));
tmp = gfc_build_array_ref (tmp, offset, NULL);
if (expr->expr_type == EXPR_FUNCTION && expr->ts.type == BT_DERIVED
&& expr->ts.u.derived->attr.alloc_comp)
{
if (!VAR_P (se->expr))
se->expr = gfc_evaluate_now (se->expr, &se->pre);
gfc_add_expr_to_block (&se->finalblock,
gfc_deallocate_alloc_comp_no_caf (
expr->ts.u.derived, se->expr, expr->rank, true));
}
if (expr->ts.type == BT_CHARACTER)
{
int i = gfc_validate_kind (BT_CHARACTER, expr->ts.kind, false);
@ -2147,6 +2157,8 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock,
*poffset = fold_build2_loc (input_location, PLUS_EXPR,
gfc_array_index_type,
*poffset, gfc_index_one_node);
if (finalblock)
gfc_add_block_to_block (finalblock, &se.finalblock);
}
else
{
@ -2795,6 +2807,7 @@ trans_array_constructor (gfc_ss * ss, locus * where)
tree neg_len;
char *msg;
stmtblock_t finalblock;
bool finalize_required;
/* Save the old values for nested checking. */
old_first_len = first_len;
@ -2973,8 +2986,11 @@ trans_array_constructor (gfc_ss * ss, locus * where)
TREE_USED (offsetvar) = 0;
gfc_init_block (&finalblock);
finalize_required = expr->must_finalize;
if (expr->ts.type == BT_DERIVED && expr->ts.u.derived->attr.alloc_comp)
finalize_required = true;
gfc_trans_array_constructor_value (&outer_loop->pre,
expr->must_finalize ? &finalblock : NULL,
finalize_required ? &finalblock : NULL,
type, desc, c, &offset, &offsetvar,
dynamic);

63
gcc/testsuite/gfortran.dg/finalize_57.f90 Normal file
View file

@ -0,0 +1,63 @@
! { dg-do compile }
! { dg-additional-options "-fdump-tree-original" }
!
! PR fortran/90068
!
! Contributed by Brad Richardson <everythingfunctional@protonmail.com>
!
program array_memory_leak
implicit none
type, abstract :: base
end type base
type, extends(base) :: extended
end type extended
type :: container
class(base), allocatable :: thing
end type
type, extends(base) :: collection
type(container), allocatable :: stuff(:)
end type collection
call run()
call bad()
contains
subroutine run()
type(collection) :: my_thing
type(container) :: a_container
a_container = newContainer(newExtended()) ! This is fine
my_thing = newCollection([a_container])
end subroutine run
subroutine bad()
type(collection) :: my_thing
my_thing = newCollection([newContainer(newExtended())]) ! This is a memory leak
end subroutine bad
function newExtended()
type(extended) :: newExtended
end function newExtended
function newContainer(thing)
class(base), intent(in) :: thing
type(container) :: newContainer
allocate(newContainer%thing, source = thing)
end function newContainer
function newCollection(things)
type(container), intent(in) :: things(:)
type(collection) :: newCollection
newCollection%stuff = things
end function newCollection
end program array_memory_leak
! { dg-final { scan-tree-dump-times "__builtin_free" 15 "original" } }