Finalization depends on the expression, not on the component.
authorThomas Koenig <tkoenig@gcc.gnu.org>
Sun, 31 May 2020 08:26:40 +0000 (10:26 +0200)
committerThomas Koenig <tkoenig@gcc.gnu.org>
Sun, 31 May 2020 10:00:07 +0000 (12:00 +0200)
This patch fixes a 8/9/10/11 regression, where finalized types
were not finalized (and deallocated), which led to memory
leaks.

gcc/fortran/ChangeLog:

2020-05-24  Thomas Koenig  <tkoenig@gcc.gnu.org>

PR fortran/94361
* class.c (finalize_component): Use expr->finalized instead of
comp->finalized.
* gfortran.h (gfc_component): Remove finalized member.
(gfc_expr): Add it here instead.

gcc/testsuite/ChangeLog:

2020-05-24  Thomas Koenig  <tkoenig@gcc.gnu.org>

PR fortran/94361
* gfortran.dg/finalize_28.f90: Adjusted free counts.
* gfortran.dg/finalize_33.f90: Likewise.
* gfortran.dg/finalize_34.f90: Likewise.
* gfortran.dg/finalize_35.f90: New test.

gcc/fortran/class.c
gcc/fortran/gfortran.h
gcc/testsuite/gfortran.dg/finalize_28.f90
gcc/testsuite/gfortran.dg/finalize_33.f90
gcc/testsuite/gfortran.dg/finalize_34.f90
gcc/testsuite/gfortran.dg/finalize_35.f90 [new file with mode: 0644]

index afd8885a1eaea5097e4c7d9d3d021e42098e9911..b1764073ab41692e599639daf5490b83cf2b42f4 100644 (file)
@@ -921,7 +921,7 @@ finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp,
   if (!comp_is_finalizable (comp))
     return;
 
-  if (comp->finalized)
+  if (expr->finalized)
     return;
 
   e = gfc_copy_expr (expr);
@@ -1012,6 +1012,7 @@ finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp,
        }
       else
        (*code) = cond;
+
     }
   else if (comp->ts.type == BT_DERIVED
            && comp->ts.u.derived->f2k_derived
@@ -1051,7 +1052,7 @@ finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp,
                            sub_ns);
       gfc_free_expr (e);
     }
-  comp->finalized = true;
+  expr->finalized = 1;
 }
 
 
index 7094791e8716c4dd9129fd29b8bd5b05d87f2f3b..5af44847f9b0152dc67437278933f3177f8115cb 100644 (file)
@@ -1107,7 +1107,6 @@ typedef struct gfc_component
   struct gfc_typebound_proc *tb;
   /* When allocatable/pointer and in a coarray the associated token.  */
   tree caf_token;
-  bool finalized;
 }
 gfc_component;
 
@@ -2218,6 +2217,9 @@ 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
index 597413b2dd3f14b82472fd3600442a891d036854..f0c9665252f46a455fe8877b0dae51f9af381e02 100644 (file)
@@ -21,4 +21,4 @@ contains
     integer, intent(out) :: edges(:,:)
   end subroutine coo_dump_edges
 end module coo_graphs
-! { dg-final { scan-tree-dump-times "__builtin_free" 5 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_free" 6 "original" } }
index 2205f9eed7f2bfb1c6ab3f9bb493ee56bf97cc56..3857e4485ee8b9ec7ceeb9baaa64c5d6ea9df8fb 100644 (file)
@@ -116,4 +116,4 @@ contains
                                                ! (iii) mci_template
 end program main_ut
 ! { dg-final { scan-tree-dump-times "__builtin_malloc" 17 "original" } }
-! { dg-final { scan-tree-dump-times "__builtin_free" 19 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_free" 20 "original" } }
index e2f02a5c51c584ea6ad5ef08df28a4f2377e8fe8..fef7dac6d89cfde84ef004155ec82fd9153b8918 100644 (file)
@@ -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" 8 "original" } }
+! { dg-final  { scan-tree-dump-times "__builtin_free" 12 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/finalize_35.f90 b/gcc/testsuite/gfortran.dg/finalize_35.f90
new file mode 100644 (file)
index 0000000..66435c4
--- /dev/null
@@ -0,0 +1,48 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+! PR 94361 - this left open some memory leaks.  Original test case by
+! Antony Lewis.
+
+module debug
+  private
+
+  Type TypeWithFinal
+   contains
+     FINAL :: finalizer  !No leak if this line is commented
+  end type TypeWithFinal
+
+  Type Tester
+     real, dimension(:), allocatable :: Dat
+     Type(TypeWithFinal) :: X
+  end Type Tester
+
+  Type :: TestType2
+     Type(Tester) :: T
+  end type TestType2
+  public Leaker
+contains
+
+  subroutine Leaker
+    type(TestType2) :: Test
+
+    allocate(Test%T%Dat(1000))
+  end subroutine Leaker
+
+  subroutine finalizer(this)
+    Type(TypeWithFinal) :: this
+  end subroutine finalizer
+
+end module debug
+
+
+program run
+  use debug
+  implicit none
+  integer i
+
+  do i=1, 1000
+     call Leaker()
+  end do
+
+end program run
+! { dg-final  { scan-tree-dump-times "__builtin_free\\ \\(ptr2" 2 "original" } }