Dear All,
This is a slight development of the patch posted on the PR itself.
class.c(finalize_component) is not able to deal correctly with
non-allocatable, derived type array components that have allocatable
components. Rather than generating loops in finalize_component, the
condition is detected in trans-stmt.c(gfc_trans_deallocate) and
gfc_deallocate_alloc_comp is called after obtaining the derived type
for the array and checking that it is not finalizable.
Happily, this fix does not generate the error:
Error: Two or more part references with nonzero rank must not be
specified at (1)
which occurs if the code is written explicitly.
Bootstraps and regtests on FC21/x86_64
OK for trunk and 4.9?
Paul
2015-02-07 Paul Thomas <pa...@gcc.gnu.org>
PR fortran/64932
* trans-stmt.c (gfc_trans_deallocate): If a component array
expression is not a descriptor type and it is a derived type
that has allocatable components and is not finalizable, then
deallocate the allocatable components.
2015-02-07 Paul Thomas <pa...@gcc.gnu.org>
PR fortran/6432
* gfortran.dg/finalize_28.f90: New test
Index: gcc/fortran/trans-stmt.c
===================================================================
*** gcc/fortran/trans-stmt.c (revision 220481)
--- gcc/fortran/trans-stmt.c (working copy)
*************** gfc_trans_deallocate (gfc_code *code)
*** 5575,5585 ****
if (expr->rank || gfc_is_coarray (expr))
{
if (expr->ts.type == BT_DERIVED && expr->ts.u.derived->attr.alloc_comp
&& !gfc_is_finalizable (expr->ts.u.derived, NULL))
{
- gfc_ref *ref;
gfc_ref *last = NULL;
for (ref = expr->ref; ref; ref = ref->next)
if (ref->type == REF_COMPONENT)
last = ref;
--- 5575,5587 ----
if (expr->rank || gfc_is_coarray (expr))
{
+ gfc_ref *ref;
+
if (expr->ts.type == BT_DERIVED && expr->ts.u.derived->attr.alloc_comp
&& !gfc_is_finalizable (expr->ts.u.derived, NULL))
{
gfc_ref *last = NULL;
+
for (ref = expr->ref; ref; ref = ref->next)
if (ref->type == REF_COMPONENT)
last = ref;
*************** gfc_trans_deallocate (gfc_code *code)
*** 5590,5602 ****
&& !(!last && expr->symtree->n.sym->attr.pointer))
{
tmp = gfc_deallocate_alloc_comp (expr->ts.u.derived, se.expr,
! expr->rank);
gfc_add_expr_to_block (&se.pre, tmp);
}
}
! tmp = gfc_array_deallocate (se.expr, pstat, errmsg, errlen,
! label_finish, expr);
! gfc_add_expr_to_block (&se.pre, tmp);
if (al->expr->ts.type == BT_CLASS)
gfc_reset_vptr (&se.pre, al->expr);
}
--- 5592,5636 ----
&& !(!last && expr->symtree->n.sym->attr.pointer))
{
tmp = gfc_deallocate_alloc_comp (expr->ts.u.derived, se.expr,
! expr->rank);
gfc_add_expr_to_block (&se.pre, tmp);
}
}
!
! if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr)))
! {
! tmp = gfc_array_deallocate (se.expr, pstat, errmsg, errlen,
! label_finish, expr);
! gfc_add_expr_to_block (&se.pre, tmp);
! }
! else if (TREE_CODE (se.expr) == COMPONENT_REF
! && TREE_CODE (TREE_TYPE (se.expr)) == ARRAY_TYPE
! && TREE_CODE (TREE_TYPE (TREE_TYPE (se.expr)))
! == RECORD_TYPE)
! {
! /* class.c(finalize_component) generates these, when a
! finalizable entity has a non-allocatable derived type array
! component, which has allocatable components. Obtain the
! derived type of the array and deallocate the allocatable
! components. */
! for (ref = expr->ref; ref; ref = ref->next)
! {
! if (ref->u.c.component->attr.dimension
! && ref->u.c.component->ts.type == BT_DERIVED)
! break;
! }
!
! if (ref && ref->u.c.component->ts.u.derived->attr.alloc_comp
! && !gfc_is_finalizable (ref->u.c.component->ts.u.derived,
! NULL))
! {
! tmp = gfc_deallocate_alloc_comp
! (ref->u.c.component->ts.u.derived,
! se.expr, expr->rank);
! gfc_add_expr_to_block (&se.pre, tmp);
! }
! }
!
if (al->expr->ts.type == BT_CLASS)
gfc_reset_vptr (&se.pre, al->expr);
}
Index: gcc/testsuite/gfortran.dg/finalize_28.f90
===================================================================
*** gcc/testsuite/gfortran.dg/finalize_28.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/finalize_28.f90 (working copy)
***************
*** 0 ****
--- 1,24 ----
+ ! { dg-do compile }
+ ! { dg-options "-fdump-tree-original" }
+ !
+ ! Test the fix for PR64932.
+ !
+ ! Reported by Daniel Shapiro <shap...@uw.edu>
+ !
+ module coo_graphs
+ implicit none
+ type :: dynamic_array
+ integer :: length, capacity, min_capacity
+ integer, allocatable :: array(:)
+ end type
+ type :: coo_graph
+ type(dynamic_array) :: edges(2)
+ integer, private :: ne
+ end type coo_graph
+ contains
+ subroutine coo_dump_edges(g, edges)
+ class(coo_graph), intent(in) :: g
+ integer, intent(out) :: edges(:,:)
+ end subroutine coo_dump_edges
+ end module coo_graphs
+ ! { dg-final { scan-tree-dump-times "__builtin_free" 3 "original" } }
