procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/44054 (Handle -Werror, -Werror=, -fdiagnostics-show-option, !GCC$ diagnostic (pragmas) and color)

Browse source 
gcc/fortran/ChangeLog:

2015-05-16  Manuel López-Ibáñez  <manu@gcc.gnu.org>

	PR fortran/44054

	Replace all calls to gfc_notify_std_1 with gfc_notify_std and
	gfc_warning_1 with gfc_warning.
	* decl.c (gfc_verify_c_interop_param): Here.
	* resolve.c (resolve_branch): Here.
	(resolve_fl_derived): Here.
	* dependency.c (gfc_check_argument_var_dependency):
	* scanner.c (preprocessor_line): Use gfc_warning_now_at. Fix line
	counter and locations before and after warning.
	* gfortran.h (gfc_warning_1, gfc_warning_now_1, gfc_notify_std_1):
	Delete.
	(gfc_warning_now_at): Declare.
	* error.c (gfc_warning_1): Delete.
	(gfc_notify_std_1): Delete.
	(gfc_warning_now_1): Delete.
	(gfc_format_decoder): Handle two locations.
	(gfc_diagnostic_build_prefix): Rename as
	gfc_diagnostic_build_kind_prefix.
	(gfc_diagnostic_build_locus_prefix): Take an expanded_location
	instead of diagnostic_info.
	(gfc_diagnostic_build_locus_prefix): Add overload that takes two
	expanded_location.
	(gfc_diagnostic_starter): Handle two locations.
	(gfc_warning_now_at): New.
	(gfc_diagnostics_init): Initialize caret_chars array.
	(gfc_diagnostics_finish): Reset caret_chars array to default.

gcc/cp/ChangeLog:

2015-05-16  Manuel López-Ibáñez  <manu@gcc.gnu.org>

	PR fortran/44054
	* error.c (cp_diagnostic_starter): Use diagnostic_location
	function.
	(cp_print_error_function): Likewise.
	(cp_printer): Replace locus pointer with accessor function.

gcc/c/ChangeLog:

2015-05-16  Manuel López-Ibáñez  <manu@gcc.gnu.org>

	PR fortran/44054
	* c-objc-common.c (c_tree_printer): Replace locus pointer with
	accessor function.

gcc/ChangeLog:

2015-05-16  Manuel López-Ibáñez  <manu@gcc.gnu.org>

	PR fortran/44054
	* tree-pretty-print.c (percent_K_format): Replace locus pointer
	with accessor function.
	* tree-diagnostic.c (diagnostic_report_current_function): Use
	diagnostic_location function.
	(maybe_unwind_expanded_macro_loc): Likewise.
	(virt_loc_aware_diagnostic_finalizer): Likewise.
	(default_tree_printer): Replace locus pointer with accessor function.
	* diagnostic.c (diagnostic_initialize): Initialize caret_chars array.
	(diagnostic_set_info_translated): Initialize second location.
	(diagnostic_build_prefix): Use CARET_LINE_MARGIN.
	(diagnostic_show_locus): Handle two locations. Call
	diagnostic_print_caret_line.
	(diagnostic_print_caret_line): New.
	(default_diagnostic_starter): Use diagnostic_location function.
	(diagnostic_report_diagnostic): Use diagnostic_location function.
	(verbatim): Do not set text.locus.
	* diagnostic.h (struct diagnostic_info): Remove location field.
	(struct diagnostic_context): Make caret_chars an array of two.
	(diagnostic_location): New inline.
	(diagnostic_expand_location): Handle two locations.
	(diagnostic_same_line): New inline.
	(diagnostic_print_caret_line): Declare.
	(CARET_LINE_MARGIN): New constant.
	* pretty-print.c (pp_printf): Do not set text.locus.
	(pp_verbatim): Do not set text.locus.
	* pretty-print.h (MAX_LOCATIONS_PER_MESSAGE): New constant.
	(struct text_info): Replace locus pointer with locations
	array. Add accessor functions.

gcc/testsuite/ChangeLog:

2015-05-16  Manuel López-Ibáñez  <manu@gcc.gnu.org>

	PR fortran/44054
	* lib/gfortran-dg.exp: Update regex to handle two locations for
	the same diagnostic without caret.
	* gfortran.dg/badline.f: Test also that line numbers are correct
	before and after "left but not entered" warning.

From-SVN: r223237
This commit is contained in:
Manuel López-Ibáñez 2015-05-16 12:31:00 +00:00
parent 40de31cfe4
commit 2a2703a2bd
16 changed files with 374 additions and 257 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
gcc/c/c-objc-common.c
View file

@ -108,8 +108,8 @@ c_tree_printer (pretty_printer *pp, text_info *text, const char *spec,
if (*spec != 'v')
{
t = va_arg (*text->args_ptr, tree);
if (set_locus && text->locus)
*text->locus = DECL_SOURCE_LOCATION (t);
if (set_locus)
text->set_location (0, DECL_SOURCE_LOCATION (t));
}
switch (*spec)

9
gcc/cp/error.c
View file

@ -3104,7 +3104,7 @@ static void
cp_diagnostic_starter (diagnostic_context *context,
diagnostic_info *diagnostic)
{
diagnostic_report_current_module (context, diagnostic->location);
diagnostic_report_current_module (context, diagnostic_location (diagnostic));
cp_print_error_function (context, diagnostic);
maybe_print_instantiation_context (context);
maybe_print_constexpr_context (context);
@ -3125,7 +3125,7 @@ cp_print_error_function (diagnostic_context *context,
if (diagnostic_last_function_changed (context, diagnostic))
{
const char *old_prefix = context->printer->prefix;
const char *file = LOCATION_FILE (diagnostic->location);
const char *file = LOCATION_FILE (diagnostic_location (diagnostic));
tree abstract_origin = diagnostic_abstract_origin (diagnostic);
char *new_prefix = (file && abstract_origin == NULL)
? file_name_as_prefix (context, file) : NULL;
@ -3471,9 +3471,6 @@ cp_printer (pretty_printer *pp, text_info *text, const char *spec,
if (precision != 0 || wide)
return false;
if (text->locus == NULL)
set_locus = false;
switch (*spec)
{
case 'A': result = args_to_string (next_tree, verbose); break;
@ -3515,7 +3512,7 @@ cp_printer (pretty_printer *pp, text_info *text, const char *spec,
pp_string (pp, result);
if (set_locus && t != NULL)
*text->locus = location_of (t);
text->set_location (0, location_of (t));
return true;
#undef next_tree
#undef next_tcode

119
gcc/diagnostic.c
View file

@ -146,7 +146,8 @@ diagnostic_initialize (diagnostic_context *context, int n_opts)
context->classify_diagnostic[i] = DK_UNSPECIFIED;
context->show_caret = false;
diagnostic_set_caret_max_width (context, pp_line_cutoff (context->printer));
context->caret_char = '^';
for (i = 0; i < MAX_LOCATIONS_PER_MESSAGE; i++)
context->caret_chars[i] = '^';
context->show_option_requested = false;
context->abort_on_error = false;
context->show_column = false;
@ -241,7 +242,9 @@ diagnostic_set_info_translated (diagnostic_info *diagnostic, const char *msg,
diagnostic->message.err_no = errno;
diagnostic->message.args_ptr = args;
diagnostic->message.format_spec = msg;
diagnostic->location = location;
diagnostic->message.set_location (0, location);
for (int i = 1; i < MAX_LOCATIONS_PER_MESSAGE; i++)
diagnostic->message.set_location (i, UNKNOWN_LOCATION);
diagnostic->override_column = 0;
diagnostic->kind = kind;
diagnostic->option_index = 0;
@ -309,14 +312,14 @@ diagnostic_build_prefix (diagnostic_context *context,
/* If LINE is longer than MAX_WIDTH, and COLUMN is not smaller than
MAX_WIDTH by some margin, then adjust the start of the line such
that the COLUMN is smaller than MAX_WIDTH minus the margin. The
margin is either 10 characters or the difference between the column
and the length of the line, whatever is smaller. The length of
LINE is given by LINE_WIDTH. */
margin is either CARET_LINE_MARGIN characters or the difference
between the column and the length of the line, whatever is smaller.
The length of LINE is given by LINE_WIDTH. */
static const char *
adjust_line (const char *line, int line_width,
int max_width, int *column_p)
{
int right_margin = 10;
int right_margin = CARET_LINE_MARGIN;
int column = *column_p;
gcc_checking_assert (line_width >= column);
@ -331,35 +334,69 @@ adjust_line (const char *line, int line_width,
}
/* Print the physical source line corresponding to the location of
this diagnostic, and a caret indicating the precise column. */
this diagnostic, and a caret indicating the precise column. This
function only prints two caret characters if the two locations
given by DIAGNOSTIC are on the same line according to
diagnostic_same_line(). */
void
diagnostic_show_locus (diagnostic_context * context,
const diagnostic_info *diagnostic)
{
const char *line;
int line_width;
char *buffer;
expanded_location s;
int max_width;
const char *saved_prefix;
const char *caret_cs, *caret_ce;
if (!context->show_caret
|| diagnostic->location <= BUILTINS_LOCATION
|| diagnostic->location == context->last_location)
|| diagnostic_location (diagnostic, 0) <= BUILTINS_LOCATION
|| diagnostic_location (diagnostic, 0) == context->last_location)
return;
context->last_location = diagnostic->location;
s = diagnostic_expand_location (diagnostic);
line = location_get_source_line (s, &line_width);
if (line == NULL || s.column > line_width)
context->last_location = diagnostic_location (diagnostic, 0);
expanded_location s0 = diagnostic_expand_location (diagnostic, 0);
expanded_location s1 = { };
/* Zero-initialized. This is checked later by diagnostic_print_caret_line. */
if (diagnostic_location (diagnostic, 1) > BUILTINS_LOCATION)
s1 = diagnostic_expand_location (diagnostic, 1);
diagnostic_print_caret_line (context, s0, s1,
context->caret_chars[0],
context->caret_chars[1]);
}
/* Print (part) of the source line given by xloc1 with caret1 pointing
at the column. If xloc2.column != 0 and it fits within the same
line as xloc1 according to diagnostic_same_line (), then caret2 is
printed at xloc2.colum. Otherwise, the caller has to set up things
to print a second caret line for xloc2. */
void
diagnostic_print_caret_line (diagnostic_context * context,
expanded_location xloc1,
expanded_location xloc2,
char caret1, char caret2)
{
if (!diagnostic_same_line (context, xloc1, xloc2))
/* This will mean ignore xloc2. */
xloc2.column = 0;
else if (xloc1.column == xloc2.column)
xloc2.column++;
int cmax = MAX (xloc1.column, xloc2.column);
int line_width;
const char *line = location_get_source_line (xloc1, &line_width);
if (line == NULL || cmax > line_width)
return;
max_width = context->caret_max_width;
line = adjust_line (line, line_width, max_width, &(s.column));
/* Center the interesting part of the source line to fit in
max_width, and adjust all columns accordingly. */
int max_width = context->caret_max_width;
int offset = (int) cmax;
line = adjust_line (line, line_width, max_width, &offset);
offset -= cmax;
cmax += offset;
xloc1.column += offset;
if (xloc2.column)
xloc2.column += offset;
/* Print the source line. */
pp_newline (context->printer);
saved_prefix = pp_get_prefix (context->printer);
const char *saved_prefix = pp_get_prefix (context->printer);
pp_set_prefix (context->printer, NULL);
pp_space (context->printer);
while (max_width > 0 && line_width > 0)
@ -373,15 +410,28 @@ diagnostic_show_locus (diagnostic_context * context,
line++;
}
pp_newline (context->printer);
/* Print the caret under the line. */
const char *caret_cs, *caret_ce;
caret_cs = colorize_start (pp_show_color (context->printer), "caret");
caret_ce = colorize_stop (pp_show_color (context->printer));
int cmin = xloc2.column
? MIN (xloc1.column, xloc2.column) : xloc1.column;
int caret_min = cmin == xloc1.column ? caret1 : caret2;
int caret_max = cmin == xloc1.column ? caret2 : caret1;
/* pp_printf does not implement %*c. */
size_t len = s.column + 3 + strlen (caret_cs) + strlen (caret_ce);
buffer = XALLOCAVEC (char, len);
snprintf (buffer, len, "%s %*c%s", caret_cs, s.column, context->caret_char,
caret_ce);
pp_string (context->printer, buffer);
pp_space (context->printer);
int i;
for (i = 0; i < cmin; i++)
pp_space (context->printer);
pp_printf (context->printer, "%s%c%s", caret_cs, caret_min, caret_ce);
if (xloc2.column)
{
for (i++; i < cmax; i++)
pp_space (context->printer);
pp_printf (context->printer, "%s%c%s", caret_cs, caret_max, caret_ce);
}
pp_set_prefix (context->printer, saved_prefix);
pp_needs_newline (context->printer) = true;
}
@ -604,7 +654,7 @@ void
default_diagnostic_starter (diagnostic_context *context,
diagnostic_info *diagnostic)
{
diagnostic_report_current_module (context, diagnostic->location);
diagnostic_report_current_module (context, diagnostic_location (diagnostic));
pp_set_prefix (context->printer, diagnostic_build_prefix (context,
diagnostic));
}
@ -716,7 +766,7 @@ bool
diagnostic_report_diagnostic (diagnostic_context *context,
diagnostic_info *diagnostic)
{
location_t location = diagnostic->location;
location_t location = diagnostic_location (diagnostic);
diagnostic_t orig_diag_kind = diagnostic->kind;
const char *saved_format_spec;
@ -825,7 +875,8 @@ diagnostic_report_diagnostic (diagnostic_context *context,
|| diagnostic_kind_count (context, DK_SORRY) > 0)
&& !context->abort_on_error)
{
expanded_location s = expand_location (diagnostic->location);
expanded_location s
= expand_location (diagnostic_location (diagnostic));
fnotice (stderr, "%s:%d: confused by earlier errors, bailing out\n",
s.file, s.line);
exit (ICE_EXIT_CODE);
@ -859,7 +910,6 @@ diagnostic_report_diagnostic (diagnostic_context *context,
free (option_text);
}
}
diagnostic->message.locus = &diagnostic->location;
diagnostic->message.x_data = &diagnostic->x_data;
diagnostic->x_data = NULL;
pp_format (context->printer, &diagnostic->message);
@ -920,7 +970,6 @@ verbatim (const char *gmsgid, ...)
text.err_no = errno;
text.args_ptr = &ap;
text.format_spec = _(gmsgid);
text.locus = NULL;
text.x_data = NULL;
pp_format_verbatim (global_dc->printer, &text);
pp_newline_and_flush (global_dc->printer);

50
gcc/diagnostic.h
View file

@ -29,8 +29,9 @@ along with GCC; see the file COPYING3. If not see
list in diagnostic.def. */
struct diagnostic_info
{
/* Text to be formatted. It also contains the location(s) for this
diagnostic. */
text_info message;
location_t location;
unsigned int override_column;
/* Auxiliary data for client. */
void *x_data;
@ -105,8 +106,8 @@ struct diagnostic_context
/* Maximum width of the source line printed. */
int caret_max_width;
/* Character used for caret diagnostics. */
char caret_char;
/* Characters used for caret diagnostics. */
char caret_chars[MAX_LOCATIONS_PER_MESSAGE];
/* True if we should print the command line option which controls
each diagnostic, if known. */
@ -300,18 +301,53 @@ void diagnostic_file_cache_fini (void);
int get_terminal_width (void);
/* Expand the location of this diagnostic. Use this function for consistency. */
/* Return the location associated to this diagnostic. Parameter WHICH
specifies which location. By default, expand the first one. */
static inline location_t
diagnostic_location (const diagnostic_info * diagnostic, int which = 0)
{
return diagnostic->message.get_location (which);
}
/* Expand the location of this diagnostic. Use this function for
consistency. Parameter WHICH specifies which location. By default,
expand the first one. */
static inline expanded_location
diagnostic_expand_location (const diagnostic_info * diagnostic)
diagnostic_expand_location (const diagnostic_info * diagnostic, int which = 0)
{
expanded_location s
= expand_location_to_spelling_point (diagnostic->location);
if (diagnostic->override_column)
= expand_location_to_spelling_point (diagnostic_location (diagnostic,
which));
if (which == 0 && diagnostic->override_column)
s.column = diagnostic->override_column;
return s;
}
/* This is somehow the right-side margin of a caret line, that is, we
print at least these many characters after the position pointed at
by the caret. */
#define CARET_LINE_MARGIN 10
/* Return true if the two locations can be represented within the same
caret line. This is used to build a prefix and also to determine
whether to print one or two caret lines. */
static inline bool
diagnostic_same_line (const diagnostic_context *context,
expanded_location s1, expanded_location s2)
{
return s2.column && s1.line == s2.line
&& context->caret_max_width - CARET_LINE_MARGIN > abs (s1.column - s2.column);
}
void
diagnostic_print_caret_line (diagnostic_context * context,
expanded_location xloc1,
expanded_location xloc2,
char caret1, char caret2);
/* Pure text formatting support functions. */
extern char *file_name_as_prefix (diagnostic_context *, const char *);

2
gcc/fortran/decl.c
View file

@ -1126,7 +1126,7 @@ gfc_verify_c_interop_param (gfc_symbol *sym)
either assumed size or explicit shape. Deferred shape is already
covered by the pointer/allocatable attribute. */
if (sym->as != NULL && sym->as->type == AS_ASSUMED_SHAPE
&& !gfc_notify_std_1 (GFC_STD_F2008_TS, "Assumed-shape array '%s' "
&& !gfc_notify_std (GFC_STD_F2008_TS, "Assumed-shape array %qs "
"at %L as dummy argument to the BIND(C) "
"procedure '%s' at %L", sym->name,
&(sym->declared_at),

2
gcc/fortran/dependency.c
View file

@ -956,7 +956,7 @@ gfc_check_argument_var_dependency (gfc_expr *var, sym_intent intent,
If a dependency is found in the case
elemental == ELEM_CHECK_VARIABLE, we will generate
a temporary, so we don't need to bother the user. */
gfc_warning_1 ("INTENT(%s) actual argument at %L might "
gfc_warning (0, "INTENT(%s) actual argument at %L might "
"interfere with actual argument at %L.",
intent == INTENT_OUT ? "OUT" : "INOUT",
&var->where, &expr->where);

363
gcc/fortran/error.c
View file

@ -807,37 +807,6 @@ gfc_clear_pp_buffer (output_buffer *this_buffer)
}
/* Issue a warning. */
/* Use gfc_warning instead, unless two locations are used in the same
warning or for scanner.c, if the location is not properly set up. */
void
gfc_warning_1 (const char *gmsgid, ...)
{
va_list argp;
if (inhibit_warnings)
return;
warning_buffer.flag = 1;
warning_buffer.index = 0;
cur_error_buffer = &warning_buffer;
va_start (argp, gmsgid);
error_print (_("Warning:"), _(gmsgid), argp);
va_end (argp);
error_char ('\0');
if (!buffered_p)
{
warnings++;
if (warnings_are_errors)
gfc_increment_error_count();
}
}
/* This is just a helper function to avoid duplicating the logic of
gfc_warning. */
@ -889,9 +858,6 @@ gfc_warning (int opt, const char *gmsgid, va_list ap)
}
/* Issue a warning. */
/* This function uses the common diagnostics, but does not support
two locations; when being used in scanner.c, ensure that the location
is properly setup. Otherwise, use gfc_warning_1. */
bool
gfc_warning (int opt, const char *gmsgid, ...)
@ -926,84 +892,6 @@ gfc_notification_std (int std)
standard does not contain the requested bits. Return false if
an error is generated. */
bool
gfc_notify_std_1 (int std, const char *gmsgid, ...)
{
va_list argp;
bool warning;
const char *msg1, *msg2;
char *buffer;
warning = ((gfc_option.warn_std & std) != 0) && !inhibit_warnings;
if ((gfc_option.allow_std & std) != 0 && !warning)
return true;
if (suppress_errors)
return warning ? true : false;
cur_error_buffer = warning ? &warning_buffer : &error_buffer;
cur_error_buffer->flag = 1;
cur_error_buffer->index = 0;
if (warning)
msg1 = _("Warning:");
else
msg1 = _("Error:");
switch (std)
{
case GFC_STD_F2008_TS:
msg2 = "TS 29113/TS 18508:";
break;
case GFC_STD_F2008_OBS:
msg2 = _("Fortran 2008 obsolescent feature:");
break;
case GFC_STD_F2008:
msg2 = "Fortran 2008:";
break;
case GFC_STD_F2003:
msg2 = "Fortran 2003:";
break;
case GFC_STD_GNU:
msg2 = _("GNU Extension:");
break;
case GFC_STD_LEGACY:
msg2 = _("Legacy Extension:");
break;
case GFC_STD_F95_OBS:
msg2 = _("Obsolescent feature:");
break;
case GFC_STD_F95_DEL:
msg2 = _("Deleted feature:");
break;
default:
gcc_unreachable ();
}
buffer = (char *) alloca (strlen (msg1) + strlen (msg2) + 2);
strcpy (buffer, msg1);
strcat (buffer, " ");
strcat (buffer, msg2);
va_start (argp, gmsgid);
error_print (buffer, _(gmsgid), argp);
va_end (argp);
error_char ('\0');
if (!buffered_p)
{
if (warning && !warnings_are_errors)
warnings++;
else
gfc_increment_error_count();
cur_error_buffer->flag = 0;
}
return (warning && !warnings_are_errors) ? true : false;
}
bool
gfc_notify_std (int std, const char *gmsgid, ...)
{
@ -1066,35 +954,6 @@ gfc_notify_std (int std, const char *gmsgid, ...)
}
/* Immediate warning (i.e. do not buffer the warning). */
/* Use gfc_warning_now instead, unless two locations are used in the same
warning or for scanner.c, if the location is not properly set up. */
void
gfc_warning_now_1 (const char *gmsgid, ...)
{
va_list argp;
bool buffered_p_saved;
if (inhibit_warnings)
return;
buffered_p_saved = buffered_p;
buffered_p = false;
warnings++;
va_start (argp, gmsgid);
error_print (_("Warning:"), _(gmsgid), argp);
va_end (argp);
error_char ('\0');
if (warnings_are_errors)
gfc_increment_error_count();
buffered_p = buffered_p_saved;
}
/* Called from output_format -- during diagnostic message processing
to handle Fortran specific format specifiers with the following meanings:
@ -1112,7 +971,7 @@ gfc_format_decoder (pretty_printer *pp,
case 'C':
case 'L':
{
static const char *result = "(1)";
static const char *result[2] = { "(1)", "(2)" };
locus *loc;
if (*spec == 'C')
loc = &gfc_current_locus;
@ -1120,13 +979,14 @@ gfc_format_decoder (pretty_printer *pp,
loc = va_arg (*text->args_ptr, locus *);
gcc_assert (loc->nextc - loc->lb->line >= 0);
unsigned int offset = loc->nextc - loc->lb->line;
gcc_assert (text->locus);
*text->locus
= linemap_position_for_loc_and_offset (line_table,
loc->lb->location,
offset);
global_dc->caret_char = '1';
pp_string (pp, result);
/* If location[0] != UNKNOWN_LOCATION means that we already
processed one of %C/%L. */
int loc_num = text->get_location (0) == UNKNOWN_LOCATION ? 0 : 1;
text->set_location (loc_num,
linemap_position_for_loc_and_offset (line_table,
loc->lb->location,
offset));
pp_string (pp, result[loc_num]);
return true;
}
default:
@ -1134,11 +994,11 @@ gfc_format_decoder (pretty_printer *pp,
}
}
/* Return a malloc'd string describing a location. The caller is
responsible for freeing the memory. */
/* Return a malloc'd string describing the kind of diagnostic. The
caller is responsible for freeing the memory. */
static char *
gfc_diagnostic_build_prefix (diagnostic_context *context,
const diagnostic_info *diagnostic)
gfc_diagnostic_build_kind_prefix (diagnostic_context *context,
const diagnostic_info *diagnostic)
{
static const char *const diagnostic_kind_text[] = {
#define DEFINE_DIAGNOSTIC_KIND(K, T, C) (T),
@ -1170,12 +1030,11 @@ gfc_diagnostic_build_prefix (diagnostic_context *context,
responsible for freeing the memory. */
static char *
gfc_diagnostic_build_locus_prefix (diagnostic_context *context,
const diagnostic_info *diagnostic)
expanded_location s)
{
pretty_printer *pp = context->printer;
const char *locus_cs = colorize_start (pp_show_color (pp), "locus");
const char *locus_ce = colorize_stop (pp_show_color (pp));
expanded_location s = diagnostic_expand_location (diagnostic);
return (s.file == NULL
? build_message_string ("%s%s:%s", locus_cs, progname, locus_ce )
: !strcmp (s.file, N_("<built-in>"))
@ -1186,35 +1045,160 @@ gfc_diagnostic_build_locus_prefix (diagnostic_context *context,
: build_message_string ("%s%s:%d:%s", locus_cs, s.file, s.line, locus_ce));
}
static void
/* Return a malloc'd string describing two locations. The caller is
responsible for freeing the memory. */
static char *
gfc_diagnostic_build_locus_prefix (diagnostic_context *context,
expanded_location s, expanded_location s2)
{
pretty_printer *pp = context->printer;
const char *locus_cs = colorize_start (pp_show_color (pp), "locus");
const char *locus_ce = colorize_stop (pp_show_color (pp));
return (s.file == NULL
? build_message_string ("%s%s:%s", locus_cs, progname, locus_ce )
: !strcmp (s.file, N_("<built-in>"))
? build_message_string ("%s%s:%s", locus_cs, s.file, locus_ce)
: context->show_column
? build_message_string ("%s%s:%d:%d-%d:%s", locus_cs, s.file, s.line,
MIN (s.column, s2.column),
MAX (s.column, s2.column), locus_ce)
: build_message_string ("%s%s:%d:%s", locus_cs, s.file, s.line,
locus_ce));
}
/* This function prints the locus (file:line:column), the diagnostic kind
(Error, Warning) and (optionally) the caret line (a source line
with '1' and/or '2' below it).
With -fdiagnostic-show-caret (the default) and for valid locations,
it prints for one location:
[locus]:
some code
1
Error: Some error at (1)
for two locations that fit in the same locus line:
[locus]:
some code and some more code
1 2
Error: Some error at (1) and (2)
and for two locations that do not fit in the same locus line:
[locus]:
some code
1
[locus2]:
some other code
2
Error: Some error at (1) and (2)
With -fno-diagnostic-show-caret or if one of the locations is not
valid, it prints for one location (or for two locations that fit in
the same locus line):
[locus]: Error: Some error at (1) and (2)
and for two locations that do not fit in the same locus line:
[name]:[locus]: Error: (1)
[name]:[locus2]: Error: Some error at (1) and (2)
*/
static void
gfc_diagnostic_starter (diagnostic_context *context,
diagnostic_info *diagnostic)
{
char * locus_prefix = gfc_diagnostic_build_locus_prefix (context, diagnostic);
char * prefix = gfc_diagnostic_build_prefix (context, diagnostic);
/* First we assume there is a caret line. */
pp_set_prefix (context->printer, NULL);
if (pp_needs_newline (context->printer))
pp_newline (context->printer);
pp_verbatim (context->printer, locus_prefix);
/* Fortran uses an empty line between locus and caret line. */
pp_newline (context->printer);
diagnostic_show_locus (context, diagnostic);
if (pp_needs_newline (context->printer))
char * kind_prefix = gfc_diagnostic_build_kind_prefix (context, diagnostic);
expanded_location s1 = diagnostic_expand_location (diagnostic);
expanded_location s2;
bool one_locus = diagnostic_location (diagnostic, 1) == UNKNOWN_LOCATION;
bool same_locus = false;
if (!one_locus)
{
s2 = diagnostic_expand_location (diagnostic, 1);
same_locus = diagnostic_same_line (context, s1, s2);
}
char * locus_prefix = (one_locus || !same_locus)
? gfc_diagnostic_build_locus_prefix (context, s1)
: gfc_diagnostic_build_locus_prefix (context, s1, s2);
if (!context->show_caret
|| diagnostic_location (diagnostic, 0) <= BUILTINS_LOCATION
|| diagnostic_location (diagnostic, 0) == context->last_location)
{
pp_set_prefix (context->printer,
concat (locus_prefix, " ", kind_prefix, NULL));
free (locus_prefix);
if (one_locus || same_locus)
{
free (kind_prefix);
return;
}
/* In this case, we print the previous locus and prefix as:
[locus]:[prefix]: (1)
and we flush with a new line before setting the new prefix. */
pp_string (context->printer, "(1)");
pp_newline (context->printer);
locus_prefix = gfc_diagnostic_build_locus_prefix (context, s2);
pp_set_prefix (context->printer,
concat (locus_prefix, " ", kind_prefix, NULL));
free (kind_prefix);
free (locus_prefix);
}
else
{
pp_verbatim (context->printer, locus_prefix);
free (locus_prefix);
/* Fortran uses an empty line between locus and caret line. */
pp_newline (context->printer);
diagnostic_show_locus (context, diagnostic);
pp_newline (context->printer);
/* If the caret line was shown, the prefix does not contain the
locus. */
pp_set_prefix (context->printer, prefix);
pp_set_prefix (context->printer, kind_prefix);
if (one_locus || same_locus)
return;
locus_prefix = gfc_diagnostic_build_locus_prefix (context, s2);
if (diagnostic_location (diagnostic, 1) <= BUILTINS_LOCATION)
{
/* No caret line for the second location. Override the previous
prefix with [locus2]:[prefix]. */
pp_set_prefix (context->printer,
concat (locus_prefix, " ", kind_prefix, NULL));
free (kind_prefix);
free (locus_prefix);
}
else
{
/* We print the caret for the second location. */
pp_verbatim (context->printer, locus_prefix);
free (locus_prefix);
/* Fortran uses an empty line between locus and caret line. */
pp_newline (context->printer);
s1.column = 0; /* Print only a caret line for s2. */
diagnostic_print_caret_line (context, s2, s1,
context->caret_chars[1], '\0');
pp_newline (context->printer);
/* If the caret line was shown, the prefix does not contain the
locus. */
pp_set_prefix (context->printer, kind_prefix);
}
}
else
{
/* Otherwise, start again. */
pp_clear_output_area(context->printer);
pp_set_prefix (context->printer, concat (locus_prefix, " ", prefix, NULL));
free (prefix);
}
free (locus_prefix);
}
static void
@ -1225,10 +1209,25 @@ gfc_diagnostic_finalizer (diagnostic_context *context,
pp_newline_and_flush (context->printer);
}
/* Immediate warning (i.e. do not buffer the warning) with an explicit
location. */
bool
gfc_warning_now_at (location_t loc, int opt, const char *gmsgid, ...)
{
va_list argp;
diagnostic_info diagnostic;
bool ret;
va_start (argp, gmsgid);
diagnostic_set_info (&diagnostic, gmsgid, &argp, loc, DK_WARNING);
diagnostic.option_index = opt;
ret = report_diagnostic (&diagnostic);
va_end (argp);
return ret;
}
/* Immediate warning (i.e. do not buffer the warning). */
/* This function uses the common diagnostics, but does not support
two locations; when being used in scanner.c, ensure that the location
is properly setup. Otherwise, use gfc_warning_now_1. */
bool
gfc_warning_now (int opt, const char *gmsgid, ...)
@ -1639,7 +1638,8 @@ gfc_diagnostics_init (void)
diagnostic_starter (global_dc) = gfc_diagnostic_starter;
diagnostic_finalizer (global_dc) = gfc_diagnostic_finalizer;
diagnostic_format_decoder (global_dc) = gfc_format_decoder;
global_dc->caret_char = '^';
global_dc->caret_chars[0] = '1';
global_dc->caret_chars[1] = '2';
pp_warning_buffer = new (XNEW (output_buffer)) output_buffer ();
pp_warning_buffer->flush_p = false;
pp_error_buffer = new (XNEW (output_buffer)) output_buffer ();
@ -1654,5 +1654,6 @@ gfc_diagnostics_finish (void)
defaults. */
diagnostic_starter (global_dc) = gfc_diagnostic_starter;
diagnostic_finalizer (global_dc) = gfc_diagnostic_finalizer;
global_dc->caret_char = '^';
global_dc->caret_chars[0] = '^';
global_dc->caret_chars[1] = '^';
}

5
gcc/fortran/gfortran.h
View file

@ -2660,10 +2660,10 @@ void gfc_buffer_error (bool);
const char *gfc_print_wide_char (gfc_char_t);
void gfc_warning_1 (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
bool gfc_warning (int opt, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
void gfc_warning_now_1 (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
bool gfc_warning_now (int opt, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
bool gfc_warning_now_at (location_t loc, int opt, const char *gmsgid, ...)
ATTRIBUTE_GCC_GFC(3,4);
void gfc_clear_warning (void);
void gfc_warning_check (void);
@ -2679,7 +2679,6 @@ bool gfc_error_check (void);
bool gfc_error_flag_test (void);
notification gfc_notification_std (int);
bool gfc_notify_std_1 (int, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
bool gfc_notify_std (int, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
/* A general purpose syntax error. */

6
gcc/fortran/resolve.c
View file

@ -8779,7 +8779,7 @@ resolve_branch (gfc_st_label *label, gfc_code *code)
/* The label is not in an enclosing block, so illegal. This was
allowed in Fortran 66, so we allow it as extension. No
further checks are necessary in this case. */
gfc_notify_std_1 (GFC_STD_LEGACY, "Label at %L is not in the same block "
gfc_notify_std (GFC_STD_LEGACY, "Label at %L is not in the same block "
"as the GOTO statement at %L", &label->where,
&code->loc);
return;
@ -12920,8 +12920,8 @@ resolve_fl_derived (gfc_symbol *sym)
if (gen_dt && gen_dt->generic && gen_dt->generic->next
&& (!gen_dt->generic->sym->attr.use_assoc
|| gen_dt->generic->sym->module != gen_dt->generic->next->sym->module)
&& !gfc_notify_std_1 (GFC_STD_F2003, "Generic name '%s' of function "
"'%s' at %L being the same name as derived "
&& !gfc_notify_std (GFC_STD_F2003, "Generic name %qs of function "
"%qs at %L being the same name as derived "
"type at %L", sym->name,
gen_dt->generic->sym == sym
? gen_dt->generic->next->sym->name

17
gcc/fortran/scanner.c
View file

@ -2014,9 +2014,13 @@ preprocessor_line (gfc_char_t *c)
if (!current_file->up
|| filename_cmp (current_file->up->filename, filename) != 0)
{
gfc_warning_now_1 ("%s:%d: file %s left but not entered",
current_file->filename, current_file->line,
filename);
linemap_line_start (line_table, current_file->line, 80);
/* ??? One could compute the exact column where the filename
starts and compute the exact location here. */
gfc_warning_now_at (linemap_position_for_column (line_table, 1),
0, "file %qs left but not entered",
filename);
current_file->line++;
if (unescape)
free (wide_filename);
free (filename);
@ -2048,8 +2052,11 @@ preprocessor_line (gfc_char_t *c)
return;
bad_cpp_line:
gfc_warning_now_1 ("%s:%d: Illegal preprocessor directive",
current_file->filename, current_file->line);
linemap_line_start (line_table, current_file->line, 80);
/* ??? One could compute the exact column where the directive
starts and compute the exact location here. */
gfc_warning_now_at (linemap_position_for_column (line_table, 2), 0,
"Illegal preprocessor directive");
current_file->line++;
}

2
gcc/pretty-print.c
View file

@ -853,7 +853,6 @@ pp_printf (pretty_printer *pp, const char *msg, ...)
text.err_no = errno;
text.args_ptr = &ap;
text.format_spec = msg;
text.locus = NULL;
pp_format (pp, &text);
pp_output_formatted_text (pp);
va_end (ap);
@ -871,7 +870,6 @@ pp_verbatim (pretty_printer *pp, const char *msg, ...)
text.err_no = errno;
text.args_ptr = &ap;
text.format_spec = msg;
text.locus = NULL;
pp_format_verbatim (pp, &text);
va_end (ap);
}

21
gcc/pretty-print.h
View file

@ -28,6 +28,11 @@ along with GCC; see the file COPYING3. If not see
/* Maximum number of format string arguments. */
#define PP_NL_ARGMAX 30
/* Maximum number of locations associated to each message. If
location 'i' is UNKNOWN_LOCATION, then location 'i+1' is not
valid. */
#define MAX_LOCATIONS_PER_MESSAGE 2
/* The type of a text to be formatted according a format specification
along with a list of things. */
struct text_info
@ -35,8 +40,22 @@ struct text_info
const char *format_spec;
va_list *args_ptr;
int err_no; /* for %m */
location_t *locus;
void **x_data;
inline void set_location (unsigned int index_of_location, location_t loc)
{
gcc_checking_assert (index_of_location < MAX_LOCATIONS_PER_MESSAGE);
this->locations[index_of_location] = loc;
}
inline location_t get_location (unsigned int index_of_location) const
{
gcc_checking_assert (index_of_location < MAX_LOCATIONS_PER_MESSAGE);
return this->locations[index_of_location];
}
private:
location_t locations[MAX_LOCATIONS_PER_MESSAGE];
};
/* How often diagnostics are prefixed by their locations:

6
gcc/testsuite/gfortran.dg/badline.f
View file

@ -1,4 +1,8 @@
subroutine foo
# illegal
# 18 "src/badline.F" 2
# illegal
end
! { dg-warning "left but not entered" "" { target *-*-* } 2 }
! { dg-warning "Illegal" "" { target *-*-* } 2 }
! { dg-warning "left but not entered" "" { target *-*-* } 3 }
! { dg-warning "Illegal" "" { target *-*-* } 4 }

12
gcc/testsuite/lib/gfortran-dg.exp
View file

@ -51,6 +51,9 @@ proc gfortran-dg-test { prog do_what extra_tool_flags } {
#
# or
# [name]:[locus]: Error: Some error
# or
# [name]:[locus]: Error: (1)
# [name]:[locus2]: Error: Some error at (1) and (2)
#
# Where [locus] is either [line] or [line].[column] or
# [line].[column]-[column] .
@ -80,14 +83,19 @@ proc gfortran-dg-test { prog do_what extra_tool_flags } {
regsub -all $two_loci $comp_output "\\1\\2:\\3: \\8\n\\5\:\\6: \\8\n" comp_output
verbose "comput_output1:\n$comp_output"
set locus_prefix "(\[^:\n\]+:\[0-9\]+:\[0-9\]+: )(Warning: |Error: )"
set two_loci2 "(^|\n)$locus_prefix\\(1\\)\n$locus_prefix$diag_regexp"
regsub -all $two_loci2 $comp_output "\\1\\2\\3\\6\n\\4\\5\\6\n" comp_output
verbose "comput_output2:\n$comp_output"
# 3. then with the form with only one locus line.
set single_locus "(^|\n)$locus_regexp$diag_regexp"
regsub -all $single_locus $comp_output "\\1\\2:\\3: \\5\n" comp_output
verbose "comput_output2:\n$comp_output"
verbose "comput_output3:\n$comp_output"
# 4. Add a line number if none exists
regsub -all "(^|\n)(Warning: |Error: )" $comp_output "\\1:0:0: \\2" comp_output
verbose "comput_output3:\n$comp_output"
verbose "comput_output4:\n$comp_output"
return [list $comp_output $output_file]
}

10
gcc/tree-diagnostic.c
View file

@ -48,7 +48,7 @@ void
diagnostic_report_current_function (diagnostic_context *context,
diagnostic_info *diagnostic)
{
diagnostic_report_current_module (context, diagnostic->location);
diagnostic_report_current_module (context, diagnostic_location (diagnostic));
lang_hooks.print_error_function (context, LOCATION_FILE (input_location),
diagnostic);
}
@ -153,7 +153,7 @@ maybe_unwind_expanded_macro_loc (diagnostic_context *context,
first macro which expansion triggered this trace was expanded
inside a system header. */
int saved_location_line =
expand_location_to_spelling_point (diagnostic->location).line;
expand_location_to_spelling_point (diagnostic_location (diagnostic)).line;
if (!LINEMAP_SYSP (map))
FOR_EACH_VEC_ELT (loc_vec, ix, iter)
@ -252,7 +252,7 @@ virt_loc_aware_diagnostic_finalizer (diagnostic_context *context,
diagnostic_info *diagnostic)
{
maybe_unwind_expanded_macro_loc (context, diagnostic,
diagnostic->location);
diagnostic_location (diagnostic));
}
/* Default tree printer. Handles declarations only. */
@ -296,8 +296,8 @@ default_tree_printer (pretty_printer *pp, text_info *text, const char *spec,
return false;
}
if (set_locus && text->locus)
*text->locus = DECL_SOURCE_LOCATION (t);
if (set_locus)
text->set_location (0, DECL_SOURCE_LOCATION (t));
if (DECL_P (t))
{

3
gcc/tree-pretty-print.c
View file

@ -3620,8 +3620,7 @@ void
percent_K_format (text_info *text)
{
tree t = va_arg (*text->args_ptr, tree), block;
gcc_assert (text->locus != NULL);
*text->locus = EXPR_LOCATION (t);
text->set_location (0, EXPR_LOCATION (t));
gcc_assert (pp_ti_abstract_origin (text) != NULL);
block = TREE_BLOCK (t);
*pp_ti_abstract_origin (text) = NULL;