Re: [PATCH,FORTRAN] Fix memory leak in finalization wrappers

[Bernhard Reutner-Fischer <rep.dot.nop@gmail.com>]

On Wed, 27 Oct 2021 23:39:43 +0200
Bernhard Reutner-Fischer <rep.dot.nop@gmail.com> wrote:

> Ping
> [hmz. it's been a while, I'll rebase and retest this one.
> Ok if it passes?]
Testing passed without any new regressions.
Ok for trunk?
thanks,
> 
> On Mon, 15 Oct 2018 10:23:06 +0200
> Bernhard Reutner-Fischer <rep.dot.nop@gmail.com> wrote:
> 
> > If a finalization is not required we created a namespace containing
> > formal arguments for an internal interface definition but never used
> > any of these. So the whole sub_ns namespace was not wired up to the
> > program and consequently was never freed. The fix is to simply not
> > generate any finalization wrappers if we know that it will be unused.
> > Note that this reverts back to the original r190869
> > (8a96d64282ac534cb597f446f02ac5d0b13249cc) handling for this case
> > by reverting this specific part of r194075
> > (f1ee56b4be7cc3892e6ccc75d73033c129098e87) for PR fortran/37336.
> > 
> > Regtests cleanly, installed to the fortran-fe-stringpool branch, sent
> > here for reference and later inclusion.
> > I might plug a few more leaks in preparation of switching to hash-maps.
> > I fear that the leaks around interfaces are another candidate ;)
> > 
> > Should probably add a tag for the compile-time leak PR68800 shouldn't i.
> > 
> > valgrind summary for e.g.
> > gfortran.dg/abstract_type_3.f03 and gfortran.dg/abstract_type_4.f03
> > where ".orig" is pristine trunk and ".mine" contains this fix:
> > 
> > at3.orig.vg:LEAK SUMMARY:
> > at3.orig.vg-   definitely lost: 8,460 bytes in 11 blocks
> > at3.orig.vg-   indirectly lost: 13,288 bytes in 55 blocks
> > at3.orig.vg-     possibly lost: 0 bytes in 0 blocks
> > at3.orig.vg-   still reachable: 572,278 bytes in 2,142 blocks
> > at3.orig.vg-        suppressed: 0 bytes in 0 blocks
> > at3.orig.vg-
> > at3.orig.vg-Use --track-origins=yes to see where uninitialised values come from
> > at3.orig.vg-ERROR SUMMARY: 38 errors from 33 contexts (suppressed: 0 from 0)
> > --
> > at3.mine.vg:LEAK SUMMARY:
> > at3.mine.vg-   definitely lost: 344 bytes in 1 blocks
> > at3.mine.vg-   indirectly lost: 7,192 bytes in 18 blocks
> > at3.mine.vg-     possibly lost: 0 bytes in 0 blocks
> > at3.mine.vg-   still reachable: 572,278 bytes in 2,142 blocks
> > at3.mine.vg-        suppressed: 0 bytes in 0 blocks
> > at3.mine.vg-
> > at3.mine.vg-ERROR SUMMARY: 1 errors from 1 contexts (suppressed: 0 from 0)
> > at3.mine.vg-ERROR SUMMARY: 1 errors from 1 contexts (suppressed: 0 from 0)
> > at4.orig.vg:LEAK SUMMARY:
> > at4.orig.vg-   definitely lost: 13,751 bytes in 12 blocks
> > at4.orig.vg-   indirectly lost: 11,976 bytes in 60 blocks
> > at4.orig.vg-     possibly lost: 0 bytes in 0 blocks
> > at4.orig.vg-   still reachable: 572,278 bytes in 2,142 blocks
> > at4.orig.vg-        suppressed: 0 bytes in 0 blocks
> > at4.orig.vg-
> > at4.orig.vg-Use --track-origins=yes to see where uninitialised values come from
> > at4.orig.vg-ERROR SUMMARY: 18 errors from 16 contexts (suppressed: 0 from 0)
> > --
> > at4.mine.vg:LEAK SUMMARY:
> > at4.mine.vg-   definitely lost: 3,008 bytes in 3 blocks
> > at4.mine.vg-   indirectly lost: 4,056 bytes in 11 blocks
> > at4.mine.vg-     possibly lost: 0 bytes in 0 blocks
> > at4.mine.vg-   still reachable: 572,278 bytes in 2,142 blocks
> > at4.mine.vg-        suppressed: 0 bytes in 0 blocks
> > at4.mine.vg-
> > at4.mine.vg-ERROR SUMMARY: 3 errors from 3 contexts (suppressed: 0 from 0)
> > at4.mine.vg-ERROR SUMMARY: 3 errors from 3 contexts (suppressed: 0 from 0)
> > 
> > gcc/fortran/ChangeLog:
> > 
> > 2018-10-12  Bernhard Reutner-Fischer  <aldot@gcc.gnu.org>
> > 
> > 	* class.c (generate_finalization_wrapper): Do leak finalization
> > 	wrappers if they will not be used.
> > 	* expr.c (gfc_free_actual_arglist): Formatting fix.
> > 	* gfortran.h (gfc_free_symbol): Pass argument by reference.
> > 	(gfc_release_symbol): Likewise.
> > 	(gfc_free_namespace): Likewise.
> > 	* symbol.c (gfc_release_symbol): Adjust acordingly.
> > 	(free_components): Set procedure pointer components
> > 	of derived types to NULL after freeing.
> > 	(free_tb_tree): Likewise.
> > 	(gfc_free_symbol): Set sym to NULL after freeing.
> > 	(gfc_free_namespace): Set namespace to NULL after freeing.
> > ---
> >  gcc/fortran/class.c    | 25 +++++++++----------------
> >  gcc/fortran/expr.c     |  2 +-
> >  gcc/fortran/gfortran.h |  6 +++---
> >  gcc/fortran/symbol.c   | 19 ++++++++++---------
> >  4 files changed, 23 insertions(+), 29 deletions(-)
> > 
> > diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
> > index 69c95fc5dfa..e0bb381a55f 100644
> > --- a/gcc/fortran/class.c
> > +++ b/gcc/fortran/class.c
> > @@ -1533,7 +1533,6 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
> >    gfc_code *last_code, *block;
> >    const char *name;
> >    bool finalizable_comp = false;
> > -  bool expr_null_wrapper = false;
> >    gfc_expr *ancestor_wrapper = NULL, *rank;
> >    gfc_iterator *iter;
> >  
> > @@ -1561,13 +1560,17 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
> >      }
> >  
> >    /* No wrapper of the ancestor and no own FINAL subroutines and allocatable
> > -     components: Return a NULL() expression; we defer this a bit to have have
> > +     components: Return a NULL() expression; we defer this a bit to have
> >       an interface declaration.  */
> >    if ((!ancestor_wrapper || ancestor_wrapper->expr_type == EXPR_NULL)
> >        && !derived->attr.alloc_comp
> >        && (!derived->f2k_derived || !derived->f2k_derived->finalizers)
> >        && !has_finalizer_component (derived))
> > -    expr_null_wrapper = true;
> > +    {
> > +      vtab_final->initializer = gfc_get_null_expr (NULL);
> > +      gcc_assert (vtab_final->ts.interface == NULL);
> > +      return;
> > +    }
> >    else
> >      /* Check whether there are new allocatable components.  */
> >      for (comp = derived->components; comp; comp = comp->next)
> > @@ -1581,7 +1584,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
> >  
> >    /* If there is no new finalizer and no new allocatable, return with
> >       an expr to the ancestor's one.  */
> > -  if (!expr_null_wrapper && !finalizable_comp
> > +  if (!finalizable_comp
> >        && (!derived->f2k_derived || !derived->f2k_derived->finalizers))
> >      {
> >        gcc_assert (ancestor_wrapper && ancestor_wrapper->ref == NULL
> > @@ -1605,8 +1608,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
> >    /* Set up the namespace.  */
> >    sub_ns = gfc_get_namespace (ns, 0);
> >    sub_ns->sibling = ns->contained;
> > -  if (!expr_null_wrapper)
> > -    ns->contained = sub_ns;
> > +  ns->contained = sub_ns;
> >    sub_ns->resolved = 1;
> >  
> >    /* Set up the procedure symbol.  */
> > @@ -1622,7 +1624,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
> >    final->ts.kind = 4;
> >    final->attr.artificial = 1;
> >    final->attr.always_explicit = 1;
> > -  final->attr.if_source = expr_null_wrapper ? IFSRC_IFBODY : IFSRC_DECL;
> > +  final->attr.if_source = IFSRC_DECL;
> >    if (ns->proc_name->attr.flavor == FL_MODULE)
> >      final->module = ns->proc_name->name;
> >    gfc_set_sym_referenced (final);
> > @@ -1672,15 +1674,6 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
> >    final->formal->next->next->sym = fini_coarray;
> >    gfc_commit_symbol (fini_coarray);
> >  
> > -  /* Return with a NULL() expression but with an interface which has
> > -     the formal arguments.  */
> > -  if (expr_null_wrapper)
> > -    {
> > -      vtab_final->initializer = gfc_get_null_expr (NULL);
> > -      vtab_final->ts.interface = final;
> > -      return;
> > -    }
> > -
> >    /* Local variables.  */
> >  
> >    gfc_get_symbol (gfc_get_string ("%s", "idx"), sub_ns, &idx);
> > diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
> > index cc12e0a8402..3d744ec9641 100644
> > --- a/gcc/fortran/expr.c
> > +++ b/gcc/fortran/expr.c
> > @@ -533,7 +533,7 @@ gfc_free_actual_arglist (gfc_actual_arglist *a1)
> >      {
> >        a2 = a1->next;
> >        if (a1->expr)
> > -      gfc_free_expr (a1->expr);
> > +	gfc_free_expr (a1->expr);
> >        free (a1);
> >        a1 = a2;
> >      }
> > diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
> > index 4612835706b..3466c42132f 100644
> > --- a/gcc/fortran/gfortran.h
> > +++ b/gcc/fortran/gfortran.h
> > @@ -3032,8 +3032,8 @@ gfc_user_op *gfc_get_uop (const char *);
> >  gfc_user_op *gfc_find_uop (const char *, gfc_namespace *);
> >  const char *gfc_get_uop_from_name (const char*);
> >  const char *gfc_get_name_from_uop (const char*);
> > -void gfc_free_symbol (gfc_symbol *);
> > -void gfc_release_symbol (gfc_symbol *);
> > +void gfc_free_symbol (gfc_symbol *&);
> > +void gfc_release_symbol (gfc_symbol *&);
> >  gfc_symbol *gfc_new_symbol (const char *, gfc_namespace *);
> >  gfc_symtree* gfc_find_symtree_in_proc (const char *, gfc_namespace *);
> >  int gfc_find_symbol (const char *, gfc_namespace *, int, gfc_symbol **);
> > @@ -3058,7 +3058,7 @@ void gfc_commit_symbols (void);
> >  void gfc_commit_symbol (gfc_symbol *);
> >  gfc_charlen *gfc_new_charlen (gfc_namespace *, gfc_charlen *);
> >  void gfc_free_charlen (gfc_charlen *, gfc_charlen *);
> > -void gfc_free_namespace (gfc_namespace *);
> > +void gfc_free_namespace (gfc_namespace *&);
> >  
> >  void gfc_symbol_init_2 (void);
> >  void gfc_symbol_done_2 (void);
> > diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
> > index 09ad2bbf0cd..c99c106a0c0 100644
> > --- a/gcc/fortran/symbol.c
> > +++ b/gcc/fortran/symbol.c
> > @@ -2590,8 +2590,9 @@ free_components (gfc_component *p)
> >  	gfc_free_expr (p->kind_expr);
> >        if (p->param_list)
> >  	gfc_free_actual_arglist (p->param_list);
> > -      free (p->tb);
> >  
> > +      free (p->tb);
> > +      p->tb = NULL;
> >        free (p);
> >      }
> >  }
> > @@ -3070,7 +3071,7 @@ set_symbol_common_block (gfc_symbol *sym, gfc_common_head *common_block)
> >  /* Remove a gfc_symbol structure and everything it points to.  */
> >  
> >  void
> > -gfc_free_symbol (gfc_symbol *sym)
> > +gfc_free_symbol (gfc_symbol *&sym)
> >  {
> >  
> >    if (sym == NULL)
> > @@ -3078,8 +3079,6 @@ gfc_free_symbol (gfc_symbol *sym)
> >  
> >    gfc_free_array_spec (sym->as);
> >  
> > -  free_components (sym->components);
> > -
> >    gfc_free_expr (sym->value);
> >  
> >    gfc_free_namelist (sym->namelist);
> > @@ -3094,19 +3093,22 @@ gfc_free_symbol (gfc_symbol *sym)
> >  
> >    gfc_free_namespace (sym->f2k_derived);
> >  
> > +  free_components (sym->components);
> > +
> >    set_symbol_common_block (sym, NULL);
> >  
> >    if (sym->param_list)
> >      gfc_free_actual_arglist (sym->param_list);
> >  
> >    free (sym);
> > +  sym = NULL;
> >  }
> >  
> >  
> >  /* Decrease the reference counter and free memory when we reach zero.  */
> >  
> >  void
> > -gfc_release_symbol (gfc_symbol *sym)
> > +gfc_release_symbol (gfc_symbol *&sym)
> >  {
> >    if (sym == NULL)
> >      return;
> > @@ -3826,10 +3828,8 @@ free_tb_tree (gfc_symtree *t)
> >  
> >    free_tb_tree (t->left);
> >    free_tb_tree (t->right);
> > -
> > -  /* TODO: Free type-bound procedure structs themselves; probably needs some
> > -     sort of ref-counting mechanism.  */
> >    free (t->n.tb);
> > +  t->n.tb = NULL;
> >    free (t);
> >  }
> >  
> > @@ -4019,7 +4019,7 @@ free_entry_list (gfc_entry_list *el)
> >     taken care of when a specific name is freed.  */
> >  
> >  void
> > -gfc_free_namespace (gfc_namespace *ns)
> > +gfc_free_namespace (gfc_namespace *&ns)
> >  {
> >    gfc_namespace *p, *q;
> >    int i;
> > @@ -4057,6 +4057,7 @@ gfc_free_namespace (gfc_namespace *ns)
> >    gfc_free_data (ns->data);
> >    p = ns->contained;
> >    free (ns);
> > +  ns = NULL;
> >  
> >    /* Recursively free any contained namespaces.  */
> >    while (p != NULL)  
>