From 2a2703a2bd0046ed60a2054df1f4f3ba5c793062 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Manuel=20L=C3=B3pez-Ib=C3=A1=C3=B1ez?= Date: Sat, 16 May 2015 12:31:00 +0000 Subject: [PATCH] re PR fortran/44054 (Handle -Werror, -Werror=, -fdiagnostics-show-option, !GCC$ diagnostic (pragmas) and color) MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit gcc/fortran/ChangeLog: 2015-05-16 Manuel López-Ibáñez 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 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 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 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 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 --- gcc/c/c-objc-common.c | 4 +- gcc/cp/error.c | 9 +- gcc/diagnostic.c | 121 +++++++--- gcc/diagnostic.h | 50 +++- gcc/fortran/decl.c | 2 +- gcc/fortran/dependency.c | 2 +- gcc/fortran/error.c | 363 ++++++++++++++-------------- gcc/fortran/gfortran.h | 5 +- gcc/fortran/resolve.c | 6 +- gcc/fortran/scanner.c | 17 +- gcc/pretty-print.c | 2 - gcc/pretty-print.h | 21 +- gcc/testsuite/gfortran.dg/badline.f | 6 +- gcc/testsuite/lib/gfortran-dg.exp | 12 +- gcc/tree-diagnostic.c | 10 +- gcc/tree-pretty-print.c | 3 +- 16 files changed, 375 insertions(+), 258 deletions(-) diff --git a/gcc/c/c-objc-common.c b/gcc/c/c-objc-common.c index 344d4e2949c..2730565e94e 100644 --- a/gcc/c/c-objc-common.c +++ b/gcc/c/c-objc-common.c @@ -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) diff --git a/gcc/cp/error.c b/gcc/cp/error.c index ce43f86b72b..ea03f7dc3a9 100644 --- a/gcc/cp/error.c +++ b/gcc/cp/error.c @@ -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 diff --git a/gcc/diagnostic.c b/gcc/diagnostic.c index 2196406f881..54e3fcfa818 100644 --- a/gcc/diagnostic.c +++ b/gcc/diagnostic.c @@ -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) - 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) @@ -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 = ≈ 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); diff --git a/gcc/diagnostic.h b/gcc/diagnostic.h index 02434d83200..1b9b7d42865 100644 --- a/gcc/diagnostic.h +++ b/gcc/diagnostic.h @@ -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 *); diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 0c15fb99036..13002d45a1f 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -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), diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.c index 63c66303497..8b07f59586a 100644 --- a/gcc/fortran/dependency.c +++ b/gcc/fortran/dependency.c @@ -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); diff --git a/gcc/fortran/error.c b/gcc/fortran/error.c index da0eb8f664e..23308b6544e 100644 --- a/gcc/fortran/error.c +++ b/gcc/fortran/error.c @@ -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_("")) @@ -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_("")) + ? 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 @@ -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] = '^'; } diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 514e93f69b0..aaa4e890979 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -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. */ diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 316b413d756..fbf260f5233 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -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 diff --git a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c index f0e6404c625..55b36250cf5 100644 --- a/gcc/fortran/scanner.c +++ b/gcc/fortran/scanner.c @@ -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++; } diff --git a/gcc/pretty-print.c b/gcc/pretty-print.c index 78d334eae88..fdc7b4da34f 100644 --- a/gcc/pretty-print.c +++ b/gcc/pretty-print.c @@ -853,7 +853,6 @@ pp_printf (pretty_printer *pp, const char *msg, ...) 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); @@ -871,7 +870,6 @@ pp_verbatim (pretty_printer *pp, const char *msg, ...) text.err_no = errno; text.args_ptr = ≈ text.format_spec = msg; - text.locus = NULL; pp_format_verbatim (pp, &text); va_end (ap); } diff --git a/gcc/pretty-print.h b/gcc/pretty-print.h index e443098a6f3..6143423ac6e 100644 --- a/gcc/pretty-print.h +++ b/gcc/pretty-print.h @@ -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: diff --git a/gcc/testsuite/gfortran.dg/badline.f b/gcc/testsuite/gfortran.dg/badline.f index 59f22e7c37e..250b06f6759 100644 --- a/gcc/testsuite/gfortran.dg/badline.f +++ b/gcc/testsuite/gfortran.dg/badline.f @@ -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 } diff --git a/gcc/testsuite/lib/gfortran-dg.exp b/gcc/testsuite/lib/gfortran-dg.exp index 225b5d0315a..ddf8f226596 100644 --- a/gcc/testsuite/lib/gfortran-dg.exp +++ b/gcc/testsuite/lib/gfortran-dg.exp @@ -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] } diff --git a/gcc/tree-diagnostic.c b/gcc/tree-diagnostic.c index 99d47cbd5d9..a3b73b24bdd 100644 --- a/gcc/tree-diagnostic.c +++ b/gcc/tree-diagnostic.c @@ -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)) { diff --git a/gcc/tree-pretty-print.c b/gcc/tree-pretty-print.c index d7c049f1f44..cf875c88856 100644 --- a/gcc/tree-pretty-print.c +++ b/gcc/tree-pretty-print.c @@ -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; -- 2.30.2