From cba68eb509ee86d3705ce9413c70d08de3b2a437 Mon Sep 17 00:00:00 2001 From: burnus Date: Sun, 2 Sep 2012 06:40:27 +0000 Subject: 2012-09-02 Tobias Burnus PR fortran/54426 * symbol.c (find_common_symtree): New function. (gfc_undo_symbols): Use it; free common_head if needed. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@190853 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 6 ++++++ gcc/fortran/symbol.c | 35 +++++++++++++++++++++++++++++++++++ 2 files changed, 41 insertions(+) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 582eb26f2c0..ea3bb324db2 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2012-09-02 Tobias Burnus + + PR fortran/54426 + * symbol.c (find_common_symtree): New function. + (gfc_undo_symbols): Use it; free common_head if needed. + 2012-08-28 Tobias Burnus PR fortran/54389 diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 5e97c4086d1..8d3b56c9569 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -2867,6 +2867,30 @@ gfc_get_ha_symbol (const char *name, gfc_symbol **result) return i; } + +/* Search for the symtree belonging to a gfc_common_head; we cannot use + head->name as the common_root symtree's name might be mangled. */ + +static gfc_symtree * +find_common_symtree (gfc_symtree *st, gfc_common_head *head) +{ + + gfc_symtree *result; + + if (st == NULL) + return NULL; + + if (st->n.common == head) + return st; + + result = find_common_symtree (st->left, head); + if (!result) + result = find_common_symtree (st->right, head); + + return result; +} + + /* Undoes all the changes made to symbols in the current statement. This subroutine is made simpler due to the fact that attributes are never removed once added. */ @@ -2890,6 +2914,17 @@ gfc_undo_symbols (void) needs to be removed to stop the resolver looking for a (possibly) dead symbol. */ + if (p->common_block->head == p && !p->common_next) + { + gfc_symtree st, *st0; + st0 = find_common_symtree (p->ns->common_root, + p->common_block); + + st.name = st0->name; + gfc_delete_bbt (&p->ns->common_root, &st, compare_symtree); + free (st0); + } + if (p->common_block->head == p) p->common_block->head = p->common_next; else -- cgit v1.2.1