On Wed, 27 Oct 2021 23:39:43 +0200
Bernhard Reutner-Fischer <rep.dot....@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....@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 <al...@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)
>
