OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/41586 ([OOP] Allocatable _scalars_ are never auto-deallocated)

Browse Source 
2009-10-19  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/41586
	* parse.c (parse_derived): Correctly set 'alloc_comp' and 'pointer_comp'
	for CLASS variables.
	* trans-array.c (structure_alloc_comps): Handle deallocation and
	nullification of allocatable scalar components.
	* trans-decl.c (gfc_get_symbol_decl): Remember allocatable scalars for
	automatic deallocation.
	(gfc_trans_deferred_vars): Automatically deallocate allocatable scalars.


2009-10-19  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/41586
	* gfortran.dg/auto_dealloc_1.f90: New test case.

From-SVN: r152988
This commit is contained in:
Janus Weil 2009-10-19 21:21:18 +02:00
parent 55165bf6b4
commit 1517fd57b6
6 changed files with 176 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
gcc/fortran/ChangeLog
View File

@ -1,3 +1,14 @@
2009-10-19 Janus Weil <janus@gcc.gnu.org>
PR fortran/41586
* parse.c (parse_derived): Correctly set 'alloc_comp' and 'pointer_comp'
for CLASS variables.
* trans-array.c (structure_alloc_comps): Handle deallocation and
nullification of allocatable scalar components.
* trans-decl.c (gfc_get_symbol_decl): Remember allocatable scalars for
automatic deallocation.
(gfc_trans_deferred_vars): Automatically deallocate allocatable scalars.
2009-10-19 Tobias Burnus <burnus@net-b.de>
Steven G. Kargl <kargl@gcc.gnu.org>

4
gcc/fortran/parse.c
View File

@ -2068,11 +2068,15 @@ endType:
{
/* Look for allocatable components. */
if (c->attr.allocatable
|| (c->ts.type == BT_CLASS
&& c->ts.u.derived->components->attr.allocatable)
|| (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.alloc_comp))
sym->attr.alloc_comp = 1;
/* Look for pointer components. */
if (c->attr.pointer
|| (c->ts.type == BT_CLASS
&& c->ts.u.derived->components->attr.pointer)
|| (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.pointer_comp))
sym->attr.pointer_comp = 1;

51
gcc/fortran/trans-array.c
View File

@ -5906,6 +5906,36 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
tmp = gfc_trans_dealloc_allocated (comp);
gfc_add_expr_to_block (&fnblock, tmp);
}
else if (c->attr.allocatable)
{
/* Allocatable scalar components. */
comp = fold_build3 (COMPONENT_REF, ctype, decl, cdecl, NULL_TREE);
tmp = gfc_deallocate_with_status (comp, NULL_TREE, true, NULL);
gfc_add_expr_to_block (&fnblock, tmp);
tmp = fold_build2 (MODIFY_EXPR, void_type_node, comp,
build_int_cst (TREE_TYPE (comp), 0));
gfc_add_expr_to_block (&fnblock, tmp);
}
else if (c->ts.type == BT_CLASS
&& c->ts.u.derived->components->attr.allocatable)
{
/* Allocatable scalar CLASS components. */
comp = fold_build3 (COMPONENT_REF, ctype, decl, cdecl, NULL_TREE);
/* Add reference to '$data' component. */
tmp = c->ts.u.derived->components->backend_decl;
comp = fold_build3 (COMPONENT_REF, TREE_TYPE (tmp),
comp, tmp, NULL_TREE);
tmp = gfc_deallocate_with_status (comp, NULL_TREE, true, NULL);
gfc_add_expr_to_block (&fnblock, tmp);
tmp = fold_build2 (MODIFY_EXPR, void_type_node, comp,
build_int_cst (TREE_TYPE (comp), 0));
gfc_add_expr_to_block (&fnblock, tmp);
}
break;
case NULLIFY_ALLOC_COMP:
@ -5917,6 +5947,27 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
decl, cdecl, NULL_TREE);
gfc_conv_descriptor_data_set (&fnblock, comp, null_pointer_node);
}
else if (c->attr.allocatable)
{
/* Allocatable scalar components. */
comp = fold_build3 (COMPONENT_REF, ctype, decl, cdecl, NULL_TREE);
tmp = fold_build2 (MODIFY_EXPR, void_type_node, comp,
build_int_cst (TREE_TYPE (comp), 0));
gfc_add_expr_to_block (&fnblock, tmp);
}
else if (c->ts.type == BT_CLASS
&& c->ts.u.derived->components->attr.allocatable)
{
/* Allocatable scalar CLASS components. */
comp = fold_build3 (COMPONENT_REF, ctype, decl, cdecl, NULL_TREE);
/* Add reference to '$data' component. */
tmp = c->ts.u.derived->components->backend_decl;
comp = fold_build3 (COMPONENT_REF, TREE_TYPE (tmp),
comp, tmp, NULL_TREE);
tmp = fold_build2 (MODIFY_EXPR, void_type_node, comp,
build_int_cst (TREE_TYPE (comp), 0));
gfc_add_expr_to_block (&fnblock, tmp);
}
else if (cmp_has_alloc_comps)
{
comp = fold_build3 (COMPONENT_REF, ctype,

59
gcc/fortran/trans-decl.c
View File

@ -1187,22 +1187,23 @@ gfc_get_symbol_decl (gfc_symbol * sym)
/* Create variables to hold the non-constant bits of array info. */
gfc_build_qualified_array (decl, sym);
/* Remember this variable for allocation/cleanup. */
gfc_defer_symbol_init (sym);
if ((sym->attr.allocatable || !sym->attr.dummy) && !sym->attr.pointer)
GFC_DECL_PACKED_ARRAY (decl) = 1;
}
if (sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.alloc_comp)
gfc_defer_symbol_init (sym);
/* This applies a derived type default initializer. */
else if (sym->ts.type == BT_DERIVED
&& sym->attr.save == SAVE_NONE
&& !sym->attr.data
&& !sym->attr.allocatable
&& (sym->value && !sym->ns->proc_name->attr.is_main_program)
&& !sym->attr.use_assoc)
/* Remember this variable for allocation/cleanup. */
if (sym->attr.dimension || sym->attr.allocatable
|| (sym->ts.type == BT_CLASS &&
(sym->ts.u.derived->components->attr.dimension
|| sym->ts.u.derived->components->attr.allocatable))
|| (sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.alloc_comp)
/* This applies a derived type default initializer. */
|| (sym->ts.type == BT_DERIVED
&& sym->attr.save == SAVE_NONE
&& !sym->attr.data
&& !sym->attr.allocatable
&& (sym->value && !sym->ns->proc_name->attr.is_main_program)
&& !sym->attr.use_assoc))
gfc_defer_symbol_init (sym);
gfc_finish_var_decl (decl, sym);
@ -3054,7 +3055,8 @@ init_intent_out_dt (gfc_symbol * proc_sym, tree body)
Allocation and initialization of array variables.
Allocation of character string variables.
Initialization and possibly repacking of dummy arrays.
Initialization of ASSIGN statement auxiliary variable. */
Initialization of ASSIGN statement auxiliary variable.
Automatic deallocation. */
tree
gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
@ -3182,6 +3184,37 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
}
else if (sym_has_alloc_comp)
fnbody = gfc_trans_deferred_array (sym, fnbody);
else if (sym->attr.allocatable
|| (sym->ts.type == BT_CLASS
&& sym->ts.u.derived->components->attr.allocatable))
{
/* Automatic deallocatation of allocatable scalars. */
tree tmp;
gfc_expr *e;
gfc_se se;
stmtblock_t block;
e = gfc_lval_expr_from_sym (sym);
if (sym->ts.type == BT_CLASS)
gfc_add_component_ref (e, "$data");
gfc_init_se (&se, NULL);
se.want_pointer = 1;
gfc_conv_expr (&se, e);
gfc_free_expr (e);
gfc_start_block (&block);
gfc_add_expr_to_block (&block, fnbody);
tmp = gfc_deallocate_with_status (se.expr, NULL_TREE, true, NULL);
gfc_add_expr_to_block (&block, tmp);
tmp = fold_build2 (MODIFY_EXPR, void_type_node,
se.expr, build_int_cst (TREE_TYPE (se.expr), 0));
gfc_add_expr_to_block (&block, tmp);
fnbody = gfc_finish_block (&block);
}
else if (sym->ts.type == BT_CHARACTER)
{
gfc_get_backend_locus (&loc);

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2009-10-19 Janus Weil <janus@gcc.gnu.org>
PR fortran/41586
* gfortran.dg/auto_dealloc_1.f90: New test case.
2009-10-18 Jakub Jelinek <jakub@redhat.com>
Port from redhat/gcc-4_4-branch:

59
gcc/testsuite/gfortran.dg/auto_dealloc_1.f90 Normal file
View File

@ -0,0 +1,59 @@
! { dg-do compile }
! { dg-options "-fdump-tree-original" }
!
! PR 41586: Allocatable _scalars_ are never auto-deallocated
!
! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
module automatic_deallocation
type t0
integer :: i
end type
type t1
real :: pi = 3.14
integer, allocatable :: j
end type
type t2
class(t0), allocatable :: k
end type t2
contains
! (1) simple allocatable scalars
subroutine a
integer, allocatable :: m
allocate (m)
m = 42
end subroutine
! (2) allocatable scalar CLASS variables
subroutine b
class(t0), allocatable :: m
allocate (t0 :: m)
m%i = 43
end subroutine
! (3) allocatable scalar components
subroutine c
type(t1) :: m
allocate (m%j)
m%j = 44
end subroutine
! (4) allocatable scalar CLASS components
subroutine d
type(t2) :: m
allocate (t0 :: m%k)
m%k%i = 45
end subroutine
end module
! { dg-final { scan-tree-dump-times "__builtin_free" 5 "original" } }
! { dg-final { cleanup-modules "automatic_deallocation" } }
! { dg-final { cleanup-tree-dump "original" } }