OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

decl.c (add_global_entry): Take locus.

Browse Source 
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.

From-SVN: r199580
This commit is contained in:
Tobias Burnus 2013-06-01 16:30:43 +02:00 committed by Tobias Burnus
parent 40a7fe1e38
commit 3a43b5b3cb
3 changed files with 35 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
gcc/fortran/ChangeLog
View File

@ -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

28
gcc/fortran/decl.c
View File

@ -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;
}

20
gcc/fortran/parse.c
View File

@ -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;
}