}
+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
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);
&& 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
--- /dev/null
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! PR 59589: [4.9 Regression] [OOP] Memory leak when deallocating polymorphic
+!
+! Contributed by Rich Townsend <townsend@astro.wisc.edu>
+
+ 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" } }