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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@223237
138bc75d-0d04-0410-961f-
82ee72b054a4
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)
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);
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;
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;
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
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;
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;
/* 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);
}
/* 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)
- return;
+ 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. */
- max_width = context->caret_max_width;
- line = adjust_line (line, line_width, max_width, &(s.column));
+ 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;
+
+ /* 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)
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;
}
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));
}
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;
|| 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);
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);
text.err_no = errno;
text.args_ptr = ≈
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);
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;
/* 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. */
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 *);
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),
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);
}
-/* 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. */
}
/* 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, ...)
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, ...)
{
va_list argp;
}
-/* 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:
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;
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:
}
}
-/* 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),
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>"))
: 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);
- }
- else
- {
- /* Otherwise, start again. */
- pp_clear_output_area(context->printer);
- pp_set_prefix (context->printer, concat (locus_prefix, " ", prefix, NULL));
- free (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);
+ }
}
- free (locus_prefix);
}
static void
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, ...)
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 ();
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] = '^';
}
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);
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. */
/* 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;
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
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);
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++;
}
text.err_no = errno;
text.args_ptr = ≈
text.format_spec = msg;
- text.locus = NULL;
pp_format (pp, &text);
pp_output_formatted_text (pp);
va_end (ap);
text.err_no = errno;
text.args_ptr = ≈
text.format_spec = msg;
- text.locus = NULL;
pp_format_verbatim (pp, &text);
va_end (ap);
}
/* 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
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:
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 }
#
# 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] .
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]
}
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);
}
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)
diagnostic_info *diagnostic)
{
maybe_unwind_expanded_macro_loc (context, diagnostic,
- diagnostic->location);
+ diagnostic_location (diagnostic));
}
/* Default tree printer. Handles declarations only. */
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))
{
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;
projects / platform / upstream / linaro-gcc.git / commitdiff