Ping
[hmz. it's been a while, I'll rebase and retest this one.
Ok if it passes?]
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)
