re PR fortran/59589 ([OOP] Memory leak when deallocating polymorphic)

2014-01-06  Janus Weil  <janus@gcc.gnu.org>

	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  <janus@gcc.gnu.org>

	PR fortran/59589
	* gfortran.dg/class_allocate_16.f90: New.

From-SVN: r206379

4 files changed, 61 insertions, 24 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 5f24087d..f35ce55 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,12 @@
 2014-01-06  Janus Weil  <janus@gcc.gnu.org>
 
+	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  <janus@gcc.gnu.org>
+
 	PR fortran/59023
 	PR fortran/59662
 	* resolve.c (resolve_global_procedure): Don't apply to c-binding
diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index 1b243f6..d3569fd 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 b5a996f6..e6576d4 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2014-01-06  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/59589
+	* gfortran.dg/class_allocate_16.f90: New.
+
 2014-01-06  Jakub Jelinek  <jakub@redhat.com>
 
 	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 0000000..2877608
--- /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 <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" } }