From 53814b8fe83f2f579f213e919b40c2793e824892 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Tobias=20Schl=C3=BCter?= Date: Sun, 11 Jul 2004 00:37:16 +0200 Subject: re PR fortran/16336 (ICE with common block in module) PR fortran/16336 * decl.c (gfc_match_save): Use-associated common block doesn't collide. * gfortran.h (gfc_common_head): Add new field 'name'. Fix typo in comment after #endif. * match.c (gfc_get_common): Add new argument from_common, mangle name if flag is set, fill in new field in structure gfc_common_head. (match_common): Set new arg in call to gfc_get_common, use-associated common block doesn't collide. * match.h (gfc_get_common): Adapt prototype. * module.c (load_commons): Set new arg in call to gfc_get_common. * symbol.c (free_common_tree): New function. (gfc_free_namespace): Call new function. * trans-common.c (several functions): Remove argument 'name', use name from gfc_common_head instead. From-SVN: r84476 --- gcc/fortran/match.c | 35 ++++++++++++++++++++++------------- 1 file changed, 22 insertions(+), 13 deletions(-) (limited to 'gcc/fortran/match.c') diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index 2d85a56..040142f 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -2049,22 +2049,38 @@ cleanup: /* Given a name, return a pointer to the common head structure, - creating it if it does not exist. + creating it if it does not exist. If FROM_MODULE is non-zero, we + mangle the name so that it doesn't interfere with commons defined + in the using namespace. TODO: Add to global symbol tree. */ gfc_common_head * -gfc_get_common (char *name) +gfc_get_common (const char *name, int from_module) { gfc_symtree *st; + static int serial = 0; + char mangled_name[GFC_MAX_SYMBOL_LEN+1]; - st = gfc_find_symtree (gfc_current_ns->common_root, name); - if (st == NULL) - st = gfc_new_symtree (&gfc_current_ns->common_root, name); + if (from_module) + { + /* A use associated common block is only needed to correctly layout + the variables it contains. */ + snprintf(mangled_name, GFC_MAX_SYMBOL_LEN, "_%d_%s", serial++, name); + st = gfc_new_symtree (&gfc_current_ns->common_root, mangled_name); + } + else + { + st = gfc_find_symtree (gfc_current_ns->common_root, name); + + if (st == NULL) + st = gfc_new_symtree (&gfc_current_ns->common_root, name); + } if (st->n.common == NULL) { st->n.common = gfc_get_common_head (); st->n.common->where = gfc_current_locus; + strcpy (st->n.common->name, name); } return st->n.common; @@ -2140,15 +2156,8 @@ gfc_match_common (void) } else { - t = gfc_get_common (name); + t = gfc_get_common (name, 0); head = &t->head; - - if (t->use_assoc) - { - gfc_error ("COMMON block '%s' at %C has already " - "been USE-associated", name); - goto cleanup; - } } if (*head == NULL) -- cgit v1.1