From patchwork Mon Apr 20 20:00:43 2015 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?b?TWFudWVsIEzDs3Blei1JYsOhw7Fleg==?= X-Patchwork-Id: 462896 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id D2D5E140273 for ; Tue, 21 Apr 2015 06:01:43 +1000 (AEST) Authentication-Results: ozlabs.org; dkim=pass reason="1024-bit key; unprotected key" header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b=Cw5T0Cee; dkim-adsp=none (unprotected policy); dkim-atps=neutral DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :mime-version:from:date:message-id:subject:to:cc:content-type; q=dns; s=default; b=JthxBTdu2u302mZvQvjU8IJopXsOjSm8KjWteQPBUaW 5UmQ3WAeDOfwE1E0mx20R3zHzVH9kMkltmA8KcucJYI7d9e09wRLcJQVSEhvJbDv GeNIjdYwFsvTKMe6iOdP6BfdemPQUy8wRZAPFK8uMRQ8u1467JthuRpEUMeH00sk = DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :mime-version:from:date:message-id:subject:to:cc:content-type; s=default; bh=vqpjxXcCk6BYFVJZfFlZgcjOFck=; b=Cw5T0Cee26gEv8NY/ jF1hW9IPaf+7RzuhJlXzHR1Ts9tYO7FSVS39xZ6gu6AngOalM/oKAtOGJdVWl7+p pxDi3KYjkOmD2gYltVN+GAnZ4xDP1k3kkcdM60rmPN2WGGWETde2YDU51ewZzHsf HfJGdmPAaN+xuQZAhaqYSJP+FU= Received: (qmail 100459 invoked by alias); 20 Apr 2015 20:01:34 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 98606 invoked by uid 89); 20 Apr 2015 20:01:33 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=0.9 required=5.0 tests=BAYES_50, FREEMAIL_FROM, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_LOW, SPF_PASS autolearn=no version=3.3.2 X-Spam-User: qpsmtpd, 2 recipients X-HELO: mail-wg0-f54.google.com Received: from mail-wg0-f54.google.com (HELO mail-wg0-f54.google.com) (74.125.82.54) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES128-GCM-SHA256 encrypted) ESMTPS; Mon, 20 Apr 2015 20:01:28 +0000 Received: by wgin8 with SMTP id n8so190904936wgi.0; Mon, 20 Apr 2015 13:01:25 -0700 (PDT) X-Received: by 10.180.231.41 with SMTP id td9mr28456226wic.69.1429560085630; Mon, 20 Apr 2015 13:01:25 -0700 (PDT) MIME-Version: 1.0 Received: by 10.28.103.70 with HTTP; Mon, 20 Apr 2015 13:00:43 -0700 (PDT) From: =?ISO-8859-1?Q?Manuel_L=F3pez=2DIb=E1=F1ez?= Date: Mon, 20 Apr 2015 22:00:43 +0200 Message-ID: Subject: [PATCH diagnostics/fortran] Handle two locations for the same diagnostic. Convert all gfc_warning_1 and gfc_notify_std_1 calls To: Gcc Patch List Cc: Dodji Seketeli , Tobias Burnus , "fortran@gcc.gnu.org List" The Fortran FE allows diagnostics with two different locations. Depending on whether these locations are on the same line or not, this may produce one or two caret lines. This is the last remaining issue left to make Fortran diagnostics use the common code. In the common diagnostics: I added support for this in the common diagnostics, although Fortran is the only user for now. The new common code should be flexible enough to support the Clang style (which I guess is likely to be what C/C++ FEs end up supporting sooner or later) while still supporting the Fortran style. Supporting this in the common diagnostics code requires having two locations in struct diagnostic_info and two pointers in struct text_info. That seems a waste and overtly complex. Thus, I moved the new location array directly to struct text_info and added an accessor function diagnostic_location(). In addition, this patch factors out the logic to determine whether two locations should be shown in the same caret/locus line and the ability to just print a caret line in diagnostic_print_caret_line(). These functions are used by the common code and the Fortran FE. In the Fortran FE: These changes allow me to convert all Fortran FE diagnostic functions to use the common code. For simplicity, this patch just converts gfc_warning and gfc_notify_std. A follow-up Fortran-only patch will convert gfc_error and remove a lot of unused code. While checking that the new code was working correctly, I noticed that the locations (as tracked by line-map) before and after the warning given in badline.f were wrong. I fixed this and added two tests to check that they are right from now on. In addition, I added a new function gfc_warning_at to pass an explicit location. I think this is better than having another %-code in gfc_format_decoder. As you can see in that function, we are now doing a lot of work just to print (1) and (2), when the location_t could simply be passed explicitly to the diagnostic functions and replace all %L and %C with explicit (1) and (2) in the calls. This will remove completely gfc_format_decoder. But I'll leave that to Fortran devs if they are interested in going that route. I had to decide what to print for -fno-diagnostics-show-caret and multiple locations. It has to be something that can be distinguished from a duplicate diagnostic, such that the testsuite can parse it as such. I chose to print: file1:line1:col1: Error: (1) file2:line2:col2: Error: message that mentions (1) and (2) I could print something else if it pleases you, but the above should only be seen if someone uses -fno-diagnostics-show-caret explicitly. Bootstrapped and regression tested on x86_64-linux-gnu. OK? gcc/fortran/ChangeLog: 2015-04-19 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_char array. (gfc_diagnostics_finish): Reset caret_char array to default. gcc/cp/ChangeLog: 2015-04-19 Manuel López-Ibáñez * error.c (cp_diagnostic_starter): Use diagnostic_location function. (cp_print_error_function): Likewise. (cp_printer): Replace locus pointer with location array. gcc/c/ChangeLog: 2015-04-19 Manuel López-Ibáñez * c-objc-common.c (c_tree_printer): Replace locus pointer with location array. gcc/ChangeLog: 2015-04-19 Manuel López-Ibáñez * tree-pretty-print.c (percent_K_format): Replace locus pointer with location array. * 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 location array. * diagnostic.c (diagnostic_initialize): Initialize caret_char array. (diagnostic_set_info_translated): Initialize second location. (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_char an array of two. (diagnostic_location): New inline. (diagnostic_expand_location): Handle two locations. (diagnostic_same_locus): New inline. (diagnostic_print_caret_line): Declare. * pretty-print.c (pp_printf): Do not set text.locus. (pp_verbatim): Do not set text.locus. * pretty-print.h (struct text_info): Replace locus pointer with location array. gcc/testsuite/ChangeLog: 2015-04-19 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. Index: gcc/tree-pretty-print.c =================================================================== --- gcc/tree-pretty-print.c (revision 222087) +++ gcc/tree-pretty-print.c (working copy) @@ -3618,12 +3618,11 @@ newline_and_indent (pretty_printer *pp, 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->location[0] = EXPR_LOCATION (t); gcc_assert (pp_ti_abstract_origin (text) != NULL); block = TREE_BLOCK (t); *pp_ti_abstract_origin (text) = NULL; if (in_lto_p) Index: gcc/c/c-objc-common.c =================================================================== --- gcc/c/c-objc-common.c (revision 222087) +++ gcc/c/c-objc-common.c (working copy) @@ -106,12 +106,12 @@ c_tree_printer (pretty_printer *pp, text } 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->location[0] = DECL_SOURCE_LOCATION (t); } switch (*spec) { case 'D': Index: gcc/tree-diagnostic.c =================================================================== --- gcc/tree-diagnostic.c (revision 222087) +++ gcc/tree-diagnostic.c (working copy) @@ -46,11 +46,11 @@ along with GCC; see the file COPYING3. that caused an error. Called from all error and warning functions. */ 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); } static void @@ -151,11 +151,11 @@ maybe_unwind_expanded_macro_loc (diagnos /* Walk LOC_VEC and print the macro expansion trace, unless the 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) { /* Sometimes, in the unwound macro expansion trace, we want to @@ -250,11 +250,11 @@ maybe_unwind_expanded_macro_loc (diagnos void 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. */ static bool default_tree_printer (pretty_printer *pp, text_info *text, const char *spec, @@ -294,12 +294,12 @@ default_tree_printer (pretty_printer *pp default: return false; } - if (set_locus && text->locus) - *text->locus = DECL_SOURCE_LOCATION (t); + if (set_locus) + text->location[0] = DECL_SOURCE_LOCATION (t); if (DECL_P (t)) { const char *n = DECL_NAME (t) ? identifier_to_locale (lang_hooks.decl_printable_name (t, 2)) Index: gcc/diagnostic.c =================================================================== --- gcc/diagnostic.c (revision 222087) +++ gcc/diagnostic.c (working copy) @@ -144,11 +144,12 @@ diagnostic_initialize (diagnostic_contex context->classify_diagnostic = XNEWVEC (diagnostic_t, n_opts); for (i = 0; i < n_opts; i++) context->classify_diagnostic[i] = DK_UNSPECIFIED; context->show_caret = false; diagnostic_set_caret_max_width (context, pp_line_cutoff (context->printer)); - context->caret_char = '^'; + context->caret_char[0] = '^'; + context->caret_char[1] = '^'; context->show_option_requested = false; context->abort_on_error = false; context->show_column = false; context->pedantic_errors = false; context->permissive = false; @@ -239,11 +240,12 @@ diagnostic_set_info_translated (diagnost diagnostic_t kind) { diagnostic->message.err_no = errno; diagnostic->message.args_ptr = args; diagnostic->message.format_spec = msg; - diagnostic->location = location; + diagnostic->message.location[0] = location; + diagnostic->message.location[1] = UNKNOWN_LOCATION; diagnostic->override_column = 0; diagnostic->kind = kind; diagnostic->option_index = 0; } @@ -329,39 +331,73 @@ adjust_line (const char *line, int line_ } return line; } /* 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 locus according to + diagnostic_same_locus(). */ 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; + expanded_location s1, s2; 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); + s1 = diagnostic_expand_location (diagnostic, 0); + if (diagnostic_location (diagnostic, 1) > BUILTINS_LOCATION) + s2 = diagnostic_expand_location (diagnostic, 1); + else + s2.column = 0; + + diagnostic_print_caret_line (context, s1, s2, + context->caret_char[0], context->caret_char[1]); +} + +/* Print (part) of the source line given by xloc1 with caret1 pointing + at the column. If xloc2.column != 0 and within the same locus as xloc1 + according to diagnostic_same_locus(), 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_locus (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) { char c = *line == '\t' ? ' ' : *line; @@ -371,19 +407,32 @@ diagnostic_show_locus (diagnostic_contex max_width--; line_width--; 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_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); - /* 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); + 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; } /* Functions at which to stop the backtrace print. It's not @@ -602,11 +651,11 @@ diagnostic_report_current_module (diagno 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)); } void @@ -714,11 +763,11 @@ diagnostic_pop_diagnostics (diagnostic_c 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; /* Give preference to being able to inhibit warnings, before they get reclassified to something else. */ @@ -823,11 +872,12 @@ diagnostic_report_diagnostic (diagnostic abort_on_error. */ if ((diagnostic_kind_count (context, DK_ERROR) > 0 || 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); } #endif @@ -857,11 +907,10 @@ diagnostic_report_diagnostic (diagnostic "[", option_text, "]", NULL)); 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); (*diagnostic_starter (context)) (context, diagnostic); pp_output_formatted_text (context->printer); @@ -918,11 +967,10 @@ verbatim (const char *gmsgid, ...) va_start (ap, 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); va_end (ap); } Index: gcc/diagnostic.h =================================================================== --- gcc/diagnostic.h (revision 222087) +++ gcc/diagnostic.h (working copy) @@ -27,12 +27,13 @@ along with GCC; see the file COPYING3. /* A diagnostic is described by the MESSAGE to send, the FILE and LINE of its context and its KIND (ice, error, warning, note, ...) See complete 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; /* The kind of diagnostic it is about. */ diagnostic_t kind; @@ -103,12 +104,12 @@ struct diagnostic_context bool show_caret; /* 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_char[2]; /* True if we should print the command line option which controls each diagnostic, if known. */ bool show_option_requested; @@ -298,22 +299,49 @@ void diagnostic_action_after_output (dia void diagnostic_file_cache_fini (void); int get_terminal_width (void); -/* Expand the location of this diagnostic. Use this function for consistency. */ +static inline location_t +diagnostic_location (const diagnostic_info * diagnostic, int which = 0) +{ + return diagnostic->message.location[which]; +} + + +/* Expand the location of this diagnostic. Use this function for consistency. + 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; } +/* Return true if the two locations can be represented within the same + locus. This is used not only for the prefix but also to determine + whether to print one or two caret lines. */ + +static inline bool +diagnostic_same_locus (const diagnostic_context *context, + expanded_location s1, expanded_location s2) +{ + return s2.column && s1.line == s2.line + && context->caret_max_width - 10 > 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 *); extern char *build_message_string (const char *, ...) ATTRIBUTE_PRINTF_1; Index: gcc/pretty-print.c =================================================================== --- gcc/pretty-print.c (revision 222087) +++ gcc/pretty-print.c (working copy) @@ -851,11 +851,10 @@ pp_printf (pretty_printer *pp, const cha va_start (ap, 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); } @@ -869,11 +868,10 @@ pp_verbatim (pretty_printer *pp, const c va_start (ap, msg); text.err_no = errno; text.args_ptr = ≈ text.format_spec = msg; - text.locus = NULL; pp_format_verbatim (pp, &text); va_end (ap); } Index: gcc/pretty-print.h =================================================================== --- gcc/pretty-print.h (revision 222087) +++ gcc/pretty-print.h (working copy) @@ -33,11 +33,13 @@ along with GCC; see the file COPYING3. struct text_info { const char *format_spec; va_list *args_ptr; int err_no; /* for %m */ - location_t *locus; + /* This message can have associated two locations at most. If the + first location is UNKNOWN_LOCATION, the second is not valid. */ + location_t location[2]; void **x_data; }; /* How often diagnostics are prefixed by their locations: o DIAGNOSTICS_SHOW_PREFIX_NEVER: never - not yet supported; Index: gcc/testsuite/lib/gfortran-dg.exp =================================================================== --- gcc/testsuite/lib/gfortran-dg.exp (revision 222087) +++ gcc/testsuite/lib/gfortran-dg.exp (working copy) @@ -49,10 +49,13 @@ proc gfortran-dg-test { prog do_what ext # 1 2 # Error: Some error at (1) and (2) # # 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] . # # We collapse these to look like: @@ -78,18 +81,23 @@ proc gfortran-dg-test { prog do_what ext # 2. We deal with the form with two different locus lines, set two_loci "(^|\n)$locus_regexp$locus_regexp$diag_regexp" 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] } proc gfortran-dg-prune { system text } { return [gcc-dg-prune $system $text] Index: gcc/testsuite/gfortran.dg/badline.f =================================================================== --- gcc/testsuite/gfortran.dg/badline.f (revision 222087) +++ gcc/testsuite/gfortran.dg/badline.f (working copy) @@ -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 } Index: gcc/cp/error.c =================================================================== --- gcc/cp/error.c (revision 222087) +++ gcc/cp/error.c (working copy) @@ -3102,11 +3102,11 @@ cxx_print_error_function (diagnostic_con 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); pp_set_prefix (context->printer, diagnostic_build_prefix (context, diagnostic)); @@ -3123,11 +3123,11 @@ cp_print_error_function (diagnostic_cont if (current_instantiation ()) return; 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; pp_set_prefix (context->printer, new_prefix); @@ -3469,13 +3469,10 @@ cp_printer (pretty_printer *pp, text_inf #define next_int va_arg (*text->args_ptr, int) 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; case 'C': result = code_to_string (next_tcode); break; case 'D': @@ -3513,11 +3510,11 @@ cp_printer (pretty_printer *pp, text_inf return false; } pp_string (pp, result); if (set_locus && t != NULL) - *text->locus = location_of (t); + text->location[0] = location_of (t); return true; #undef next_tree #undef next_tcode #undef next_lang #undef next_int Index: gcc/fortran/decl.c =================================================================== --- gcc/fortran/decl.c (revision 222087) +++ gcc/fortran/decl.c (working copy) @@ -1124,11 +1124,11 @@ gfc_verify_c_interop_param (gfc_symbol * /* Make sure that if it has the dimension attribute, that it is 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), sym->ns->proc_name->name, &(sym->ns->proc_name->declared_at))) Index: gcc/fortran/gfortran.h =================================================================== --- gcc/fortran/gfortran.h (revision 222087) +++ gcc/fortran/gfortran.h (working copy) @@ -2656,14 +2656,14 @@ void gfc_diagnostics_init (void); void gfc_diagnostics_finish (void); 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); void gfc_error_1 (const char *, ...) ATTRIBUTE_GCC_GFC(1,2); @@ -2675,11 +2675,10 @@ void gfc_internal_error (const char *, . void gfc_clear_error (void); 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. */ #define gfc_syntax_error(ST) \ gfc_error ("Syntax error in %s statement at %C", gfc_ascii_statement (ST)); Index: gcc/fortran/error.c =================================================================== --- gcc/fortran/error.c (revision 222087) +++ gcc/fortran/error.c (working copy) @@ -805,41 +805,10 @@ gfc_clear_pp_buffer (output_buffer *this pp_clear_output_area (pp); pp->buffer = tmp_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. */ static bool gfc_warning (int opt, const char *gmsgid, va_list ap) @@ -887,13 +856,10 @@ gfc_warning (int opt, const char *gmsgid va_end (argp); return ret; } /* 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, ...) { va_list argp; @@ -925,88 +891,10 @@ gfc_notification_std (int std) feature. An error/warning will be issued if the currently selected 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, ...) { va_list argp; bool warning; const char *msg, *msg2; @@ -1064,39 +952,10 @@ gfc_notify_std (int std, const char *gms return (warning && !warnings_are_errors) ? true : false; } -/* 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: %C Current locus (no argument) %L Takes locus argument @@ -1110,37 +969,38 @@ gfc_format_decoder (pretty_printer *pp, switch (*spec) { 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; else 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 + /* If location[0] != UNKNOWN_LOCATION means that we already + processed one of %C/%L. */ + int loc_num = text->location[0] == UNKNOWN_LOCATION ? 0 : 1; + text->location[loc_num] = linemap_position_for_loc_and_offset (line_table, loc->lb->location, offset); - global_dc->caret_char = '1'; - pp_string (pp, result); + pp_string (pp, result[loc_num]); return true; } default: return false; } } -/* 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), #include "gfc-diagnostic.def" #undef DEFINE_DIAGNOSTIC_KIND @@ -1168,69 +1028,208 @@ gfc_diagnostic_build_prefix (diagnostic_ /* Return a malloc'd string describing a location. The caller is 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_("")) ? build_message_string ("%s%s:%s", locus_cs, s.file, locus_ce) : context->show_column ? build_message_string ("%s%s:%d:%d:%s", locus_cs, s.file, s.line, s.column, locus_ce) : 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_locus (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); - /* If the caret line was shown, the prefix does not contain the - locus. */ - pp_set_prefix (context->printer, prefix); + 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 + else { - /* Otherwise, start again. */ - pp_clear_output_area(context->printer); - pp_set_prefix (context->printer, concat (locus_prefix, " ", prefix, NULL)); - free (prefix); + 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, 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_char[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 gfc_diagnostic_finalizer (diagnostic_context *context, diagnostic_info *diagnostic ATTRIBUTE_UNUSED) { pp_destroy_prefix (context->printer); 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, ...) { va_list argp; @@ -1637,11 +1636,12 @@ void 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_char[0] = '1'; + global_dc->caret_char[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 (); pp_error_buffer->flush_p = false; } @@ -1652,7 +1652,8 @@ gfc_diagnostics_finish (void) tree_diagnostics_defaults (global_dc); /* We still want to use the gfc starter and finalizer, not the tree defaults. */ diagnostic_starter (global_dc) = gfc_diagnostic_starter; diagnostic_finalizer (global_dc) = gfc_diagnostic_finalizer; - global_dc->caret_char = '^'; + global_dc->caret_char[0] = '^'; + global_dc->caret_char[1] = '^'; } Index: gcc/fortran/scanner.c =================================================================== --- gcc/fortran/scanner.c (revision 222087) +++ gcc/fortran/scanner.c (working copy) @@ -2012,13 +2012,17 @@ preprocessor_line (gfc_char_t *c) if (flag[2]) /* Ending current file. */ { 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; } @@ -2046,12 +2050,15 @@ preprocessor_line (gfc_char_t *c) 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++; } static bool load_file (const char *, const char *, bool); Index: gcc/fortran/resolve.c =================================================================== --- gcc/fortran/resolve.c (revision 222087) +++ gcc/fortran/resolve.c (working copy) @@ -8777,11 +8777,11 @@ resolve_branch (gfc_st_label *label, gfc } /* 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; } @@ -12918,12 +12918,12 @@ resolve_fl_derived (gfc_symbol *sym) if (!sym->attr.is_class) gfc_find_symbol (sym->name, sym->ns, 0, &gen_dt); 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 : gen_dt->generic->sym->name, gen_dt->generic->sym == sym Index: gcc/fortran/dependency.c =================================================================== --- gcc/fortran/dependency.c (revision 222087) +++ gcc/fortran/dependency.c (working copy) @@ -954,11 +954,11 @@ gfc_check_argument_var_dependency (gfc_e /* We are told not to check dependencies. We do it, however, and issue a warning in case we find one. 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); } return 0;