I am still not happy with changing the length of the displayed
source-code in error messages to infinity if not terminal is available.
One reason is that for long lines (e.g. generated code or long trailing
comment lines) - the output is not very readable. And that the terminal
is not available happens quite often, e.g. if one uses pipes to "less"
or "tee" - or redirects to a file. Admittedly, in Fortran code, the line
length is typically not extremely long; thus, the trimming usually does
not cause - nor does increasing the limit.
* * *
I think that one reason for the wish to extend the displayed lines lies
elsewhere: gfortran sometimes does a bad job with the column location in
error messages. That's especially visible in the test suite which uses
long dg-error/dg-warning comments after the actual code.
Thus, I think we should fix the bad column location. (That's beneficial,
independent whether one increased the trim length or not.) This patch
fixes a bunch of those isses, but one can surely do more.
Comments?
One example is:
END BLOCK ! { dg-error "Expected block name of 'myname2'" }
1
Error: Expected block name of 'myname2' in END BLOCK statement at (1)
for which one gets with the patch:
END ASSOCIATE ! { dg-error "Expected block name of 'myname'" }
1
Error: Expected block name of 'myname' in END ASSOCIATE statement at (1)
Build and regtested on x86-64-gnu-linux.
OK for the trunk?
Tobias
2013-06-01 Tobias Burnus <bur...@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.
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 6ab9cc7..f1aa31e 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 a223a2c..f98a213 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;
}
