From c8e20bd09307de2a787351a88c93458b32d45363 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Tobias=20Schl=C3=BCter?= Date: Sat, 15 May 2004 22:29:06 +0200 Subject: re PR fortran/13742 (Not Implemented: initial values for COMMON or EQUIVALENCE) PR fortran/13742 * decl.c (add_init_expr_to_sym): Verify that COMMON variable is not initialized in a disallowed fashion. * match.c (gfc_match_common): Likewise. (var_element): Verify that variable is not in the blank COMMON, if it is in a common. From-SVN: r81899 --- gcc/fortran/match.c | 33 ++++++++++++++++++++++++++++++--- 1 file changed, 30 insertions(+), 3 deletions(-) (limited to 'gcc/fortran/match.c') diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index 1b2b763..6c7251f 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -2338,6 +2338,19 @@ gfc_match_common (void) goto cleanup; } + if (sym->value != NULL + && (common_name == NULL || !sym->attr.data)) + { + if (common_name == NULL) + gfc_error ("Previously initialized symbol '%s' in " + "blank COMMON block at %C", sym->name); + else + gfc_error ("Previously initialized symbol '%s' in " + "COMMON block '%s' at %C", sym->name, + common_name->name); + goto cleanup; + } + if (gfc_add_in_common (&sym->attr, NULL) == FAILURE) goto cleanup; @@ -2814,6 +2827,7 @@ static match var_element (gfc_data_variable * new) { match m; + gfc_symbol *sym, *t; memset (new, '\0', sizeof (gfc_data_variable)); @@ -2824,14 +2838,27 @@ var_element (gfc_data_variable * new) if (m != MATCH_YES) return m; - if (new->expr->symtree->n.sym->value != NULL) + sym = new->expr->symtree->n.sym; + + if(sym->value != NULL) { gfc_error ("Variable '%s' at %C already has an initialization", - new->expr->symtree->n.sym->name); + sym->name); return MATCH_ERROR; } - new->expr->symtree->n.sym->attr.data = 1; + if (sym->attr.in_common) + /* See if sym is in the blank common block. */ + for (t = sym->ns->blank_common; t; t = t->common_next) + if (sym == t) + { + gfc_error ("DATA statement at %C may not initialize variable " + "'%s' from blank COMMON", sym->name); + return MATCH_ERROR; + } + + sym->attr.data = 1; + return MATCH_YES; } -- cgit v1.1