Hi all,
here is a regression fix for polymorphic deallocation. The attached
patch is identical in functionality to the one-liner in comment 13 of
the PR, fixing a bug in the detection of finalizable components (with
include allocatable components).
All it does in addition to the one-liner is to encapsulate the code
necessary to detect finalizable components into a function, which is
then used in two different places. This makes the code less
error-prone and more readable.
Regtested on x86_64-unknown-linux-gnu. Ok for trunk?
Cheers,
Janus
2014-01-06 Janus Weil <[email protected]>
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 <[email protected]>
PR fortran/59589
* gfortran.dg/class_allocate_16.f90: New.
Index: gcc/fortran/class.c
===================================================================
--- gcc/fortran/class.c (revision 206374)
+++ gcc/fortran/class.c (working copy)
@@ -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,21 +822,9 @@ finalize_component (gfc_expr *expr, gfc_symbol *de
gfc_expr *e;
gfc_ref *ref;
- if (comp->ts.type != BT_DERIVED && comp->ts.type != BT_CLASS
- && !comp->attr.allocatable)
+ if (!comp_is_finalizable (comp))
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))
- return;
-
e = gfc_copy_expr (expr);
if (!e->ref)
e->ref = ref = gfc_get_ref ();
@@ -1462,17 +1469,7 @@ generate_finalization_wrapper (gfc_symbol *derived
&& 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
! { dg-do compile }
! { dg-options "-fdump-tree-original" }
!
! PR 59589: [4.9 Regression] [OOP] Memory leak when deallocating polymorphic
!
! Contributed by Rich Townsend <[email protected]>
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" } }
