[PATCH diagnostics/fortran] Handle two locations for the same diagnostic. Convert all gfc_warning_1 and gfc_notify_std_1 calls
Manuel López-Ibáñez
lopezibanez@gmail.com
Fri May 8 22:13:00 GMT 2015
Hi Dodji,
Thanks for the review. I followed all your suggestions. For the
accessor functions, I was not sure what type you would prefer, so I
implemented them as C++ methods and made use of 'private' to be sure
they are the only way to access the locations array. If you want me to
change it, just tell me what you prefer. I also replaced
diagnostic_same_locus with diagnostic_same_line.
Bootstrapped & regression tested on x86_64-linux-gnu.
OK?
Manuel.
gcc/fortran/ChangeLog:
2015-05-08 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-08 Manuel López-Ibáñez <manu@gcc.gnu.org>
* 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-08 Manuel López-Ibáñez <manu@gcc.gnu.org>
* c-objc-common.c (c_tree_printer): Replace locus pointer with
accessor function.
gcc/ChangeLog:
2015-05-08 Manuel López-Ibáñez <manu@gcc.gnu.org>
* 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-08 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.
-------------- next part --------------
Index: gcc/c/c-objc-common.c
===================================================================
--- gcc/c/c-objc-common.c (revision 222903)
+++ 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->set_location (0) = DECL_SOURCE_LOCATION (t);
}
switch (*spec)
{
case 'D':
Index: gcc/tree-pretty-print.c
===================================================================
--- gcc/tree-pretty-print.c (revision 222903)
+++ 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->set_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/tree-diagnostic.c
===================================================================
--- gcc/tree-diagnostic.c (revision 222903)
+++ 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->set_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 222903)
+++ 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 = '^';
+ 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;
context->pedantic_errors = false;
context->permissive = false;
@@ -239,11 +240,13 @@ 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.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;
}
@@ -307,18 +310,18 @@ diagnostic_build_prefix (diagnostic_cont
}
/* 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);
right_margin = MIN (line_width - column, right_margin);
right_margin = max_width - right_margin;
@@ -329,39 +332,72 @@ 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 line according to
+ diagnostic_same_line(). */
void
diagnostic_show_locus (diagnostic_context * context,
const diagnostic_info *diagnostic)
{
- const char *line;
- int line_width;
- char *buffer;
- expanded_location s;
- int max_width;
- const char *saved_prefix;
- const char *caret_cs, *caret_ce;
-
if (!context->show_caret
- || diagnostic->location <= BUILTINS_LOCATION
- || diagnostic->location == context->last_location)
+ || diagnostic_location (diagnostic, 0) <= BUILTINS_LOCATION
+ || diagnostic_location (diagnostic, 0) == context->last_location)
return;
- context->last_location = diagnostic->location;
- s = diagnostic_expand_location (diagnostic);
- line = location_get_source_line (s, &line_width);
- if (line == NULL || s.column > line_width)
+ context->last_location = diagnostic_location (diagnostic, 0);
+ expanded_location s0 = diagnostic_expand_location (diagnostic, 0);
+ expanded_location s1 = { };
+ /* Zero-initialized. This is checked later by diagnostic_print_caret_line. */
+
+ if (diagnostic_location (diagnostic, 1) > BUILTINS_LOCATION)
+ s1 = diagnostic_expand_location (diagnostic, 1);
+
+ diagnostic_print_caret_line (context, s0, s1,
+ context->caret_chars[0], context->caret_chars[1]);
+}
+
+/* Print (part) of the source line given by xloc1 with caret1 pointing
+ at the column. If xloc2.column != 0 and it fits within the same
+ line as xloc1 according to diagnostic_same_line (), then caret2 is
+ printed at xloc2.colum. Otherwise, the caller has to set up things
+ to print a second caret line for xloc2. */
+void
+diagnostic_print_caret_line (diagnostic_context * context,
+ expanded_location xloc1,
+ expanded_location xloc2,
+ char caret1, char caret2)
+{
+ if (!diagnostic_same_line (context, xloc1, xloc2))
+ /* This will mean ignore xloc2. */
+ xloc2.column = 0;
+ else if (xloc1.column == xloc2.column)
+ xloc2.column++;
+
+ int cmax = MAX (xloc1.column, xloc2.column);
+ int line_width;
+ const char *line = location_get_source_line (xloc1, &line_width);
+ if (line == NULL || cmax > line_width)
return;
- max_width = context->caret_max_width;
- line = adjust_line (line, line_width, max_width, &(s.column));
+ /* Center the interesting part of the source line to fit in
+ max_width, and adjust all columns accordingly. */
+ int max_width = context->caret_max_width;
+ int offset = (int) cmax;
+ line = adjust_line (line, line_width, max_width, &offset);
+ offset -= cmax;
+ cmax += offset;
+ xloc1.column += offset;
+ if (xloc2.column)
+ xloc2.column += offset;
+ /* Print the source line. */
pp_newline (context->printer);
- saved_prefix = pp_get_prefix (context->printer);
+ const char *saved_prefix = pp_get_prefix (context->printer);
pp_set_prefix (context->printer, NULL);
pp_space (context->printer);
while (max_width > 0 && line_width > 0)
{
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 222903)
+++ 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_chars[MAX_LOCATIONS_PER_MESSAGE];
/* True if we should print the command line option which controls
each diagnostic, if known. */
bool show_option_requested;
@@ -298,22 +299,56 @@ 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. */
+/* Return the location associated to this diagnostic. 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.
+ 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 *);
extern char *build_message_string (const char *, ...) ATTRIBUTE_PRINTF_1;
Index: gcc/pretty-print.c
===================================================================
--- gcc/pretty-print.c (revision 222903)
+++ 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 222903)
+++ gcc/pretty-print.h (working copy)
@@ -26,19 +26,39 @@ along with GCC; see the file COPYING3.
#include "wide-int-print.h"
/* 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
{
+public:
const char *format_spec;
va_list *args_ptr;
int err_no; /* for %m */
- location_t *locus;
void **x_data;
+
+ inline location_t & set_location (unsigned int index_of_location)
+ {
+ gcc_checking_assert (index_of_location < MAX_LOCATIONS_PER_MESSAGE);
+ return this->locations[index_of_location];
+ }
+
+ 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:
o DIAGNOSTICS_SHOW_PREFIX_NEVER: never - not yet supported;
o DIAGNOSTICS_SHOW_PREFIX_ONCE: emit only once;
Index: gcc/testsuite/lib/gfortran-dg.exp
===================================================================
--- gcc/testsuite/lib/gfortran-dg.exp (revision 222903)
+++ 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 222903)
+++ 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 222903)
+++ 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->set_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 222903)
+++ 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 222903)
+++ 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 222903)
+++ 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->get_location (0) == UNKNOWN_LOCATION ? 0 : 1;
+ text->set_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_("<built-in>"))
? 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_("<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);
- /* 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_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
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_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 ();
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_chars[0] = '^';
+ global_dc->caret_chars[1] = '^';
}
Index: gcc/fortran/scanner.c
===================================================================
--- gcc/fortran/scanner.c (revision 222903)
+++ 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 222903)
+++ 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 222903)
+++ 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;
More information about the Fortran
mailing list