When avoiding double deallocation, look at namespace, expression and component.

Our finalization handling is a mess.  Really, we should get to try and get
this fixed for gcc 11.

In the meantime, here is a patch which fixes a regression I introduced
when fixing a regression with a memory leak.  The important thing
here is to realize that we do not need to finalize (and deallocate)
multiple times for the same expression and the same component
in the same namespace.  It might cause code size regressions, but
better big code than wrong code...

Backported from r11-1296-g1af22e455584ef5fcad2b4474c1efc3fd26f6cb3 .

gcc/fortran/ChangeLog:

	PR fortran/94109
	* class.c (finalize_component): Return early if finalization has
	already happened for expression and component within namespace.
	* gfortran.h (gfc_was_finalized): New type.
	(gfc_namespace): Add member was_finalzed.
	(gfc_expr): Remove finalized.
	* symbol.c (gfc_free_namespace): Free was_finalized.

gcc/testsuite/ChangeLog:

	PR fortran/94109
	* gfortran.dg/finalize_34.f90: Adjust free counts.
	* gfortran.dg/finalize_36.f90: New test.

diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index c49f1ae27bf72018c67fe96a72d8735e6e06ef6d..84314a089c3ac3f86eef9b850099fb968a6899bd 100644 (file)
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -912,12 +912,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)
@@ -1047,7 +1053,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 84bd335b9201547c2c82559d86c3fc37d76894a0..c514b88b47f1e88f8d0f9a0000788abe51d753af 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1749,6 +1749,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?  */
@@ -1841,6 +1851,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;
 
@@ -2191,9 +2206,6 @@ typedef struct gfc_expr
 
   unsigned int do_not_warn : 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 801a7733fef8152ee9a7780e53f2ba49c50465ec..ecdb50887ed5f56be11a40c1f4b1581a5a56d1b6 100644 (file)
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -4033,6 +4033,7 @@ gfc_free_namespace (gfc_namespace *ns)
 {
   gfc_namespace *p, *q;
   int i;
+  gfc_was_finalized *f;
 
   if (ns == NULL)
     return;
@@ -4065,6 +4066,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 fef7dac6d89cfde84ef004155ec82fd9153b8918..8fb801d42357a2f117fd96260c804df43ed76221 100644 (file)
--- 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 (file)
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" } }