5 files changed, 82 insertions, 7 deletions
diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index 2b55859..cfc4502 100644
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -920,12 +920,18 @@ finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp,
 {
   gfc_expr *e;
   gfc_ref *ref;
+  gfc_was_finalized *f;
 
   if (!comp_is_finalizable (comp))
     return;
 
-  if (expr->finalized)
-    return;
+  /* If this expression with this component has been finalized
+     already in this namespace, there is nothing to do.  */
+  for (f = sub_ns->was_finalized; f; f = f->next)
+    {
+      if (f->e == expr && f->c == comp)
+	return;
+    }
 
   e = gfc_copy_expr (expr);
   if (!e->ref)
@@ -1055,7 +1061,13 @@ finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp,
 			    sub_ns);
       gfc_free_expr (e);
     }
-  expr->finalized = 1;
+
+  /* Record that this was finalized already in this namespace.  */
+  f = sub_ns->was_finalized;
+  sub_ns->was_finalized = XCNEW (gfc_was_finalized);
+  sub_ns->was_finalized->e = expr;
+  sub_ns->was_finalized->c = comp;
+  sub_ns->was_finalized->next = f;
 }
 
 
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 6d76efb..c12a8be 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1774,6 +1774,16 @@ gfc_oacc_routine_name;
 
 #define gfc_get_oacc_routine_name() XCNEW (gfc_oacc_routine_name)
 
+/* Node in linked list to see what has already been finalized
+   earlier.  */
+
+typedef struct gfc_was_finalized {
+  gfc_expr *e;
+  gfc_component *c;
+  struct gfc_was_finalized *next;
+}
+gfc_was_finalized;
+
 /* A namespace describes the contents of procedure, module, interface block
    or BLOCK construct.  */
 /* ??? Anything else use these?  */
@@ -1866,6 +1876,11 @@ typedef struct gfc_namespace
   /* Linked list of !$omp declare simd constructs.  */
   struct gfc_omp_declare_simd *omp_declare_simd;
 
+  /* A hash set for the the gfc expressions that have already
+     been finalized in this namespace.  */
+
+  gfc_was_finalized *was_finalized;
+
   /* Set to 1 if namespace is a BLOCK DATA program unit.  */
   unsigned is_block_data:1;
 
@@ -2218,9 +2233,6 @@ typedef struct gfc_expr
   /* Set this if the expression came from expanding an array constructor.  */
   unsigned int from_constructor : 1;
 
-  /* Set this if the expression has already been finalized.  */
-  unsigned int finalized : 1;
-
   /* If an expression comes from a Hollerith constant or compile-time
      evaluation of a transfer statement, it may have a prescribed target-
      memory representation, and these cannot always be backformed from
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index b967061..ba388ff 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -4017,6 +4017,7 @@ gfc_free_namespace (gfc_namespace *ns)
 {
   gfc_namespace *p, *q;
   int i;
+  gfc_was_finalized *f;
 
   if (ns == NULL)
     return;
@@ -4049,6 +4050,17 @@ gfc_free_namespace (gfc_namespace *ns)
     gfc_free_interface (ns->op[i]);
 
   gfc_free_data (ns->data);
+
+  /* Free all the expr + component combinations that have been
+     finalized.  */
+  f = ns->was_finalized;
+  while (f)
+    {
+      gfc_was_finalized* current = f;
+      f = f->next;
+      free (current);
+    }
+
   p = ns->contained;
   free (ns);
 
diff --git a/gcc/testsuite/gfortran.dg/finalize_34.f90 b/gcc/testsuite/gfortran.dg/finalize_34.f90
index fef7dac..8fb801d 100644
--- a/gcc/testsuite/gfortran.dg/finalize_34.f90
+++ b/gcc/testsuite/gfortran.dg/finalize_34.f90
@@ -22,4 +22,4 @@ program main
   use testmodule
   type(evtlist_type), dimension(10) :: a
 end program main
-! { dg-final  { scan-tree-dump-times "__builtin_free" 12 "original" } }
+! { dg-final  { scan-tree-dump-times "__builtin_free" 24 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/finalize_36.f90 b/gcc/testsuite/gfortran.dg/finalize_36.f90
new file mode 100644
index 0000000..432f547
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/finalize_36.f90
@@ -0,0 +1,39 @@
+! { dg-do run }
+! { dg-additional-options "-fdump-tree-original" }
+! PR 94109
+! This used to leak memory.  Test case by Antony Lewis.
+    module debug
+    implicit none
+
+    Type Tester
+        real, dimension(:), allocatable :: Dat, Dat2
+    end Type
+
+    Type TestType2
+        Type(Tester) :: T
+    end type TestType2
+
+    contains
+
+    subroutine Leaker
+    class(TestType2), pointer :: ActiveState
+    Type(Tester) :: Temp
+
+    allocate(Temp%Dat2(10000))
+
+    allocate(TestType2::ActiveState)
+    ActiveState%T = Temp
+    deallocate(ActiveState)
+
+    end subroutine
+
+    end module
+
+
+    program run
+    use debug
+
+    call Leaker()
+
+    end program
+! { dg-final { scan-tree-dump-times "__builtin_free\\ \\(ptr2" 4 "original" } }