diff options
-rw-r--r-- | gcc/fortran/ChangeLog | 8 | ||||
-rw-r--r-- | gcc/fortran/decl.c | 28 | ||||
-rw-r--r-- | gcc/fortran/parse.c | 20 |
3 files changed, 35 insertions, 21 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 8447e7a3496..4d76a444f93 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2013-06-01 Tobias Burnus <burnus@net-b.de> + + * decl.c (add_global_entry): Take locus. + (gfc_match_entry): Update call. + (gfc_match_end): Better error location. + * parse.c (parse_block_data, parse_module, add_global_procedure, + add_global_program): Use better locus data. + 2013-05-31 Tobias Burnus <burnus@net-b.de> PR fortran/57456 diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 6ab9cc78438..f1aa31e07be 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -5354,7 +5354,8 @@ cleanup: to return false upon finding an existing global entry. */ static bool -add_global_entry (const char *name, const char *binding_label, bool sub) +add_global_entry (const char *name, const char *binding_label, bool sub, + locus *where) { gfc_gsymbol *s; enum gfc_symbol_type type; @@ -5369,14 +5370,14 @@ add_global_entry (const char *name, const char *binding_label, bool sub) if (s->defined || (s->type != GSYM_UNKNOWN && s->type != type)) { - gfc_global_used(s, NULL); + gfc_global_used (s, where); return false; } else { s->type = type; s->sym_name = name; - s->where = gfc_current_locus; + s->where = *where; s->defined = 1; s->ns = gfc_current_ns; } @@ -5391,7 +5392,7 @@ add_global_entry (const char *name, const char *binding_label, bool sub) if (s->defined || (s->type != GSYM_UNKNOWN && s->type != type)) { - gfc_global_used(s, NULL); + gfc_global_used (s, where); return false; } else @@ -5399,7 +5400,7 @@ add_global_entry (const char *name, const char *binding_label, bool sub) s->type = type; s->sym_name = name; s->binding_label = binding_label; - s->where = gfc_current_locus; + s->where = *where; s->defined = 1; s->ns = gfc_current_ns; } @@ -5528,6 +5529,7 @@ gfc_match_entry (void) /* Check what next non-whitespace character is so we can tell if there is the required parens if we have a BIND(C). */ + old_loc = gfc_current_locus; gfc_gobble_whitespace (); peek_char = gfc_peek_ascii_char (); @@ -5555,7 +5557,8 @@ gfc_match_entry (void) } if (!gfc_current_ns->parent - && !add_global_entry (name, entry->binding_label, true)) + && !add_global_entry (name, entry->binding_label, true, + &old_loc)) return MATCH_ERROR; /* An entry in a subroutine. */ @@ -5574,7 +5577,6 @@ gfc_match_entry (void) ENTRY f() RESULT (r) can't be written as ENTRY f RESULT (r). */ - old_loc = gfc_current_locus; if (gfc_match_eos () == MATCH_YES) { gfc_current_locus = old_loc; @@ -5624,7 +5626,8 @@ gfc_match_entry (void) } if (!gfc_current_ns->parent - && !add_global_entry (name, entry->binding_label, false)) + && !add_global_entry (name, entry->binding_label, false, + &old_loc)) return MATCH_ERROR; } @@ -6108,6 +6111,7 @@ gfc_match_end (gfc_statement *st) goto cleanup; } + old_loc = gfc_current_locus; if (gfc_match_eos () == MATCH_YES) { if (!eos_ok && (*st == ST_END_SUBROUTINE || *st == ST_END_FUNCTION)) @@ -6131,10 +6135,12 @@ gfc_match_end (gfc_statement *st) /* Verify that we've got the sort of end-block that we're expecting. */ if (gfc_match (target) != MATCH_YES) { - gfc_error ("Expecting %s statement at %C", gfc_ascii_statement (*st)); + gfc_error ("Expecting %s statement at %L", gfc_ascii_statement (*st), + &old_loc); goto cleanup; } + old_loc = gfc_current_locus; /* If we're at the end, make sure a block name wasn't required. */ if (gfc_match_eos () == MATCH_YES) { @@ -6147,8 +6153,8 @@ gfc_match_end (gfc_statement *st) if (!block_name) return MATCH_YES; - gfc_error ("Expected block name of '%s' in %s statement at %C", - block_name, gfc_ascii_statement (*st)); + gfc_error ("Expected block name of '%s' in %s statement at %L", + block_name, gfc_ascii_statement (*st), &old_loc); return MATCH_ERROR; } diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index a223a2cb704..f98a21399e3 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -4270,11 +4270,11 @@ parse_block_data (void) s = gfc_get_gsymbol (gfc_new_block->name); if (s->defined || (s->type != GSYM_UNKNOWN && s->type != GSYM_BLOCK_DATA)) - gfc_global_used(s, NULL); + gfc_global_used (s, &gfc_new_block->declared_at); else { s->type = GSYM_BLOCK_DATA; - s->where = gfc_current_locus; + s->where = gfc_new_block->declared_at; s->defined = 1; } } @@ -4302,11 +4302,11 @@ parse_module (void) s = gfc_get_gsymbol (gfc_new_block->name); if (s->defined || (s->type != GSYM_UNKNOWN && s->type != GSYM_MODULE)) - gfc_global_used(s, NULL); + gfc_global_used (s, &gfc_new_block->declared_at); else { s->type = GSYM_MODULE; - s->where = gfc_current_locus; + s->where = gfc_new_block->declared_at; s->defined = 1; } @@ -4360,7 +4360,7 @@ add_global_procedure (bool sub) || (s->type != GSYM_UNKNOWN && s->type != (sub ? GSYM_SUBROUTINE : GSYM_FUNCTION))) { - gfc_global_used (s, NULL); + gfc_global_used (s, &gfc_new_block->declared_at); /* Silence follow-up errors. */ gfc_new_block->binding_label = NULL; } @@ -4368,7 +4368,7 @@ add_global_procedure (bool sub) { s->type = sub ? GSYM_SUBROUTINE : GSYM_FUNCTION; s->sym_name = gfc_new_block->name; - s->where = gfc_current_locus; + s->where = gfc_new_block->declared_at; s->defined = 1; s->ns = gfc_current_ns; } @@ -4385,7 +4385,7 @@ add_global_procedure (bool sub) || (s->type != GSYM_UNKNOWN && s->type != (sub ? GSYM_SUBROUTINE : GSYM_FUNCTION))) { - gfc_global_used (s, NULL); + gfc_global_used (s, &gfc_new_block->declared_at); /* Silence follow-up errors. */ gfc_new_block->binding_label = NULL; } @@ -4394,7 +4394,7 @@ add_global_procedure (bool sub) s->type = sub ? GSYM_SUBROUTINE : GSYM_FUNCTION; s->sym_name = gfc_new_block->name; s->binding_label = gfc_new_block->binding_label; - s->where = gfc_current_locus; + s->where = gfc_new_block->declared_at; s->defined = 1; s->ns = gfc_current_ns; } @@ -4414,11 +4414,11 @@ add_global_program (void) s = gfc_get_gsymbol (gfc_new_block->name); if (s->defined || (s->type != GSYM_UNKNOWN && s->type != GSYM_PROGRAM)) - gfc_global_used(s, NULL); + gfc_global_used (s, &gfc_new_block->declared_at); else { s->type = GSYM_PROGRAM; - s->where = gfc_current_locus; + s->where = gfc_new_block->declared_at; s->defined = 1; s->ns = gfc_current_ns; } |