Am 31.03.19 um 18:10 schrieb Thomas Koenig:
Hello world,

the attached patch

Now really attached.


! { dg-do compile }
! { dg-additional-options "-fdump-tree-original" }
! PR 87352 - this used to cause an excessive number of deallocations.
module testmodule
  implicit none
  public

  type :: evtlist_type
     real,  allocatable, dimension(:) :: p1
     real,  allocatable, dimension(:) :: p2
     real,  allocatable, dimension(:) :: p3
     real,  allocatable, dimension(:) :: p4
  end type evtlist_type

  type :: evtlistlist_type
     type(evtlist_type)  :: evtlist(1:1)
  end type evtlistlist_type

end module testmodule 

program main
  use testmodule
  type(evtlist_type), dimension(10) :: a
end program main
! { dg-final  { scan-tree-dump-times "__builtin_free" 8 "original" } }
Index: fortran/gfortran.h
===================================================================
--- fortran/gfortran.h	(Revision 269895)
+++ fortran/gfortran.h	(Arbeitskopie)
@@ -1094,6 +1094,7 @@ 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;
 
Index: fortran/class.c
===================================================================
--- fortran/class.c	(Revision 269895)
+++ fortran/class.c	(Arbeitskopie)
@@ -911,6 +911,9 @@ finalize_component (gfc_expr *expr, gfc_symbol *de
   if (!comp_is_finalizable (comp))
     return;
 
+  if (comp->finalized)
+    return;
+
   e = gfc_copy_expr (expr);
   if (!e->ref)
     e->ref = ref = gfc_get_ref ();
@@ -1038,6 +1041,7 @@ finalize_component (gfc_expr *expr, gfc_symbol *de
 			    sub_ns);
       gfc_free_expr (e);
     }
+  comp->finalized = true;
 }
 
 
Index: testsuite/gfortran.dg/finalize_28.f90
===================================================================
--- testsuite/gfortran.dg/finalize_28.f90	(Revision 269895)
+++ testsuite/gfortran.dg/finalize_28.f90	(Arbeitskopie)
@@ -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" 6 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_free" 5 "original" } }
Index: testsuite/gfortran.dg/finalize_33.f90
===================================================================
--- testsuite/gfortran.dg/finalize_33.f90	(Revision 269895)
+++ testsuite/gfortran.dg/finalize_33.f90	(Arbeitskopie)
@@ -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" 20 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_free" 19 "original" } }

Reply via email to