From c9d3fa768b5a5abca8cfb27c78fd1e3da0d4d3cf Mon Sep 17 00:00:00 2001 From: Janus Weil Date: Tue, 7 Jan 2014 00:21:39 +0100 Subject: [PATCH] re PR fortran/59589 ([OOP] Memory leak when deallocating polymorphic) 2014-01-06 Janus Weil PR fortran/59589 * class.c (comp_is_finalizable): New function to dermine if a given component is finalizable. (finalize_component, generate_finalization_wrapper): Use it. 2014-01-06 Janus Weil PR fortran/59589 * gfortran.dg/class_allocate_16.f90: New. From-SVN: r206379 --- gcc/fortran/ChangeLog | 7 +++ gcc/fortran/class.c | 45 +++++++++---------- gcc/testsuite/ChangeLog | 5 +++ .../gfortran.dg/class_allocate_16.f90 | 28 ++++++++++++ 4 files changed, 61 insertions(+), 24 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/class_allocate_16.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 5f24087d120..f35ce55185c 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2014-01-06 Janus Weil + + PR fortran/59589 + * class.c (comp_is_finalizable): New function to dermine if a given + component is finalizable. + (finalize_component, generate_finalization_wrapper): Use it. + 2014-01-06 Janus Weil PR fortran/59023 diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c index 1b243f686b9..d3569fd6ba8 100644 --- a/gcc/fortran/class.c +++ b/gcc/fortran/class.c @@ -787,6 +787,25 @@ has_finalizer_component (gfc_symbol *derived) } +static bool +comp_is_finalizable (gfc_component *comp) +{ + if (comp->attr.allocatable && comp->ts.type != BT_CLASS) + return true; + else if (comp->ts.type == BT_DERIVED && !comp->attr.pointer + && (comp->ts.u.derived->attr.alloc_comp + || has_finalizer_component (comp->ts.u.derived) + || (comp->ts.u.derived->f2k_derived + && comp->ts.u.derived->f2k_derived->finalizers))) + return true; + else if (comp->ts.type == BT_CLASS && CLASS_DATA (comp) + && CLASS_DATA (comp)->attr.allocatable) + return true; + else + return false; +} + + /* Call DEALLOCATE for the passed component if it is allocatable, if it is neither allocatable nor a pointer but has a finalizer, call it. If it is a nonpointer component with allocatable components or has finalizers, walk @@ -803,19 +822,7 @@ finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp, gfc_expr *e; gfc_ref *ref; - if (comp->ts.type != BT_DERIVED && comp->ts.type != BT_CLASS - && !comp->attr.allocatable) - return; - - if ((comp->ts.type == BT_DERIVED && comp->attr.pointer) - || (comp->ts.type == BT_CLASS && CLASS_DATA (comp) - && CLASS_DATA (comp)->attr.pointer)) - return; - - if (comp->ts.type == BT_DERIVED && !comp->attr.allocatable - && (comp->ts.u.derived->f2k_derived == NULL - || comp->ts.u.derived->f2k_derived->finalizers == NULL) - && !has_finalizer_component (comp->ts.u.derived)) + if (!comp_is_finalizable (comp)) return; e = gfc_copy_expr (expr); @@ -1462,17 +1469,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, && ancestor_wrapper && ancestor_wrapper->expr_type != EXPR_NULL) continue; - if (comp->ts.type != BT_CLASS && !comp->attr.pointer - && (comp->attr.allocatable - || (comp->ts.type == BT_DERIVED - && (comp->ts.u.derived->attr.alloc_comp - || has_finalizer_component (comp->ts.u.derived) - || (comp->ts.u.derived->f2k_derived - && comp->ts.u.derived->f2k_derived->finalizers))))) - finalizable_comp = true; - else if (comp->ts.type == BT_CLASS && CLASS_DATA (comp) - && CLASS_DATA (comp)->attr.allocatable) - finalizable_comp = true; + finalizable_comp |= comp_is_finalizable (comp); } /* If there is no new finalizer and no new allocatable, return with diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index b5a996f610b..e6576d46e11 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2014-01-06 Janus Weil + + PR fortran/59589 + * gfortran.dg/class_allocate_16.f90: New. + 2014-01-06 Jakub Jelinek PR target/59644 diff --git a/gcc/testsuite/gfortran.dg/class_allocate_16.f90 b/gcc/testsuite/gfortran.dg/class_allocate_16.f90 new file mode 100644 index 00000000000..28776084d86 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/class_allocate_16.f90 @@ -0,0 +1,28 @@ +! { dg-do compile } +! { dg-options "-fdump-tree-original" } +! +! PR 59589: [4.9 Regression] [OOP] Memory leak when deallocating polymorphic +! +! Contributed by Rich Townsend + + implicit none + + type :: foo + real, allocatable :: x(:) + end type + + type :: bar + type(foo) :: f + end type + + class(bar), allocatable :: b + + allocate(bar::b) + allocate(b%f%x(1000000)) + b%f%x = 1. + deallocate(b) + +end + +! { dg-final { scan-tree-dump-times "__builtin_free" 4 "original" } } +! { dg-final { cleanup-tree-dump "original" } } -- 2.30.2