Branch data Line data Source code
1 : : /* Handle errors.
2 : : Copyright (C) 2000-2025 Free Software Foundation, Inc.
3 : : Contributed by Andy Vaught & Niels Kristian Bech Jensen
4 : :
5 : : This file is part of GCC.
6 : :
7 : : GCC is free software; you can redistribute it and/or modify it under
8 : : the terms of the GNU General Public License as published by the Free
9 : : Software Foundation; either version 3, or (at your option) any later
10 : : version.
11 : :
12 : : GCC is distributed in the hope that it will be useful, but WITHOUT ANY
13 : : WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 : : FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
15 : : for more details.
16 : :
17 : : You should have received a copy of the GNU General Public License
18 : : along with GCC; see the file COPYING3. If not see
19 : : <http://www.gnu.org/licenses/>. */
20 : :
21 : : /* Handle the inevitable errors. A major catch here is that things
22 : : flagged as errors in one match subroutine can conceivably be legal
23 : : elsewhere. This means that error messages are recorded and saved
24 : : for possible use later. If a line does not match a legal
25 : : construction, then the saved error message is reported. */
26 : :
27 : : #include "config.h"
28 : : #include "system.h"
29 : : #include "coretypes.h"
30 : : #include "options.h"
31 : : #include "gfortran.h"
32 : :
33 : : #include "diagnostic.h"
34 : : #include "diagnostic-color.h"
35 : : #include "tree-diagnostic.h" /* tree_diagnostics_defaults */
36 : : #include "diagnostic-format-text.h"
37 : :
38 : : static int suppress_errors = 0;
39 : :
40 : : static bool warnings_not_errors = false;
41 : :
42 : : /* True if the error/warnings should be buffered. */
43 : : static bool buffered_p;
44 : :
45 : : static gfc_error_buffer *error_buffer;
46 : : static diagnostic_buffer *pp_error_buffer, *pp_warning_buffer;
47 : :
48 : 8144544 : gfc_error_buffer::gfc_error_buffer ()
49 : 8144544 : : flag (false), buffer (*global_dc)
50 : : {
51 : 8144544 : }
52 : :
53 : : /* Return a location_t suitable for 'tree' for a gfortran locus. During
54 : : parsing in gfortran, loc->u.lb->location contains only the line number
55 : : and LOCATION_COLUMN is 0; hence, the column has to be added when generating
56 : : locations for 'tree'. If available, return location_t directly, which
57 : : might be a range. */
58 : :
59 : : location_t
60 : 19507195 : gfc_get_location_with_offset (locus *loc, unsigned offset)
61 : : {
62 : 19507195 : if (loc->nextc == (gfc_char_t *) -1)
63 : : {
64 : 394337 : gcc_checking_assert (offset == 0);
65 : 394337 : return loc->u.location;
66 : : }
67 : 19112858 : gcc_checking_assert (loc->nextc >= loc->u.lb->line);
68 : 19112858 : return linemap_position_for_loc_and_offset (line_table, loc->u.lb->location,
69 : 19112858 : loc->nextc - loc->u.lb->line
70 : 19112858 : + offset);
71 : : }
72 : :
73 : : /* Convert a locus to a range. */
74 : :
75 : : locus
76 : 7355459 : gfc_get_location_range (locus *caret_loc, unsigned caret_offset,
77 : : locus *start_loc, unsigned start_offset,
78 : : locus *end_loc)
79 : : {
80 : 7355459 : location_t caret;
81 : 7355459 : location_t start = gfc_get_location_with_offset (start_loc, start_offset);
82 : 7355459 : location_t end = gfc_get_location_with_offset (end_loc, 0);
83 : :
84 : 7355459 : if (caret_loc)
85 : 12 : caret = gfc_get_location_with_offset (caret_loc, caret_offset);
86 : :
87 : 12 : locus range;
88 : 12 : range.nextc = (gfc_char_t *) -1;
89 : 7355459 : range.u.location = make_location (caret_loc ? caret : start, start, end);
90 : 7355459 : return range;
91 : : }
92 : :
93 : : /* Return buffered_p. */
94 : : bool
95 : 73 : gfc_buffered_p (void)
96 : : {
97 : 73 : return buffered_p;
98 : : }
99 : :
100 : : /* Go one level deeper suppressing errors. */
101 : :
102 : : void
103 : 445615 : gfc_push_suppress_errors (void)
104 : : {
105 : 445615 : gcc_assert (suppress_errors >= 0);
106 : 445615 : ++suppress_errors;
107 : 445615 : }
108 : :
109 : : static void
110 : : gfc_error_opt (int opt, const char *gmsgid, va_list ap) ATTRIBUTE_GCC_GFC(2,0);
111 : :
112 : : static bool
113 : : gfc_warning (int opt, const char *gmsgid, va_list ap) ATTRIBUTE_GCC_GFC(2,0);
114 : :
115 : :
116 : : /* Leave one level of error suppressing. */
117 : :
118 : : void
119 : 445615 : gfc_pop_suppress_errors (void)
120 : : {
121 : 445615 : gcc_assert (suppress_errors > 0);
122 : 445615 : --suppress_errors;
123 : 445615 : }
124 : :
125 : :
126 : : /* Query whether errors are suppressed. */
127 : :
128 : : bool
129 : 142 : gfc_query_suppress_errors (void)
130 : : {
131 : 142 : return suppress_errors > 0;
132 : : }
133 : :
134 : :
135 : : /* Per-file error initialization. */
136 : :
137 : : void
138 : 30444 : gfc_error_init_1 (void)
139 : : {
140 : 30444 : gfc_buffer_error (false);
141 : 30444 : }
142 : :
143 : :
144 : : /* Set the flag for buffering errors or not. */
145 : :
146 : : void
147 : 6134986 : gfc_buffer_error (bool flag)
148 : : {
149 : 6134986 : buffered_p = flag;
150 : 6134986 : }
151 : :
152 : :
153 : : static int
154 : 25 : print_wide_char_into_buffer (gfc_char_t c, char *buf)
155 : : {
156 : 25 : static const char xdigit[16] = { '0', '1', '2', '3', '4', '5', '6',
157 : : '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F' };
158 : :
159 : 25 : if (gfc_wide_is_printable (c) || c == '\t')
160 : : {
161 : 2 : buf[1] = '\0';
162 : : /* Tabulation is output as a space. */
163 : 2 : buf[0] = (unsigned char) (c == '\t' ? ' ' : c);
164 : 2 : return 1;
165 : : }
166 : 23 : else if (c < ((gfc_char_t) 1 << 8))
167 : : {
168 : 14 : buf[4] = '\0';
169 : 14 : buf[3] = xdigit[c & 0x0F];
170 : 14 : c = c >> 4;
171 : 14 : buf[2] = xdigit[c & 0x0F];
172 : :
173 : 14 : buf[1] = 'x';
174 : 14 : buf[0] = '\\';
175 : 14 : return 4;
176 : : }
177 : 9 : else if (c < ((gfc_char_t) 1 << 16))
178 : : {
179 : 8 : buf[6] = '\0';
180 : 8 : buf[5] = xdigit[c & 0x0F];
181 : 8 : c = c >> 4;
182 : 8 : buf[4] = xdigit[c & 0x0F];
183 : 8 : c = c >> 4;
184 : 8 : buf[3] = xdigit[c & 0x0F];
185 : 8 : c = c >> 4;
186 : 8 : buf[2] = xdigit[c & 0x0F];
187 : :
188 : 8 : buf[1] = 'u';
189 : 8 : buf[0] = '\\';
190 : 8 : return 6;
191 : : }
192 : : else
193 : : {
194 : 1 : buf[10] = '\0';
195 : 1 : buf[9] = xdigit[c & 0x0F];
196 : 1 : c = c >> 4;
197 : 1 : buf[8] = xdigit[c & 0x0F];
198 : 1 : c = c >> 4;
199 : 1 : buf[7] = xdigit[c & 0x0F];
200 : 1 : c = c >> 4;
201 : 1 : buf[6] = xdigit[c & 0x0F];
202 : 1 : c = c >> 4;
203 : 1 : buf[5] = xdigit[c & 0x0F];
204 : 1 : c = c >> 4;
205 : 1 : buf[4] = xdigit[c & 0x0F];
206 : 1 : c = c >> 4;
207 : 1 : buf[3] = xdigit[c & 0x0F];
208 : 1 : c = c >> 4;
209 : 1 : buf[2] = xdigit[c & 0x0F];
210 : :
211 : 1 : buf[1] = 'U';
212 : 1 : buf[0] = '\\';
213 : 1 : return 10;
214 : : }
215 : : }
216 : :
217 : : static char wide_char_print_buffer[11];
218 : :
219 : : const char *
220 : 25 : gfc_print_wide_char (gfc_char_t c)
221 : : {
222 : 25 : print_wide_char_into_buffer (c, wide_char_print_buffer);
223 : 25 : return wide_char_print_buffer;
224 : : }
225 : :
226 : :
227 : : /* Clear any output buffered in THIS_BUFFER without issuing
228 : : it to global_dc. */
229 : :
230 : : static void
231 : 21948100 : gfc_clear_diagnostic_buffer (diagnostic_buffer *this_buffer)
232 : : {
233 : 21948100 : gcc_assert (this_buffer);
234 : 21948100 : global_dc->clear_diagnostic_buffer (*this_buffer);
235 : 21948100 : }
236 : :
237 : : /* The currently-printing diagnostic, for use by gfc_format_decoder,
238 : : for colorizing %C and %L. */
239 : :
240 : : static diagnostic_info *curr_diagnostic;
241 : :
242 : : /* A helper function to call diagnostic_report_diagnostic, while setting
243 : : curr_diagnostic for the duration of the call. */
244 : :
245 : : static bool
246 : 1201839 : gfc_report_diagnostic (diagnostic_info *diagnostic)
247 : : {
248 : 1201839 : gcc_assert (diagnostic != NULL);
249 : 1201839 : curr_diagnostic = diagnostic;
250 : 1201839 : bool ret = diagnostic_report_diagnostic (global_dc, diagnostic);
251 : 1201831 : curr_diagnostic = NULL;
252 : 1201831 : return ret;
253 : : }
254 : :
255 : : /* This is just a helper function to avoid duplicating the logic of
256 : : gfc_warning. */
257 : :
258 : : static bool
259 : 19470 : gfc_warning (int opt, const char *gmsgid, va_list ap)
260 : : {
261 : 19470 : va_list argp;
262 : 19470 : va_copy (argp, ap);
263 : :
264 : 19470 : diagnostic_info diagnostic;
265 : 19470 : rich_location rich_loc (line_table, UNKNOWN_LOCATION);
266 : 19470 : diagnostic_buffer *old_buffer = global_dc->get_diagnostic_buffer ();
267 : 19470 : gcc_assert (!old_buffer);
268 : :
269 : 19470 : gfc_clear_diagnostic_buffer (pp_warning_buffer);
270 : :
271 : 19470 : if (buffered_p)
272 : 15661 : global_dc->set_diagnostic_buffer (pp_warning_buffer);
273 : :
274 : 19470 : diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc,
275 : : DK_WARNING);
276 : 19470 : diagnostic.option_id = opt;
277 : 19470 : bool ret = gfc_report_diagnostic (&diagnostic);
278 : :
279 : 19470 : if (buffered_p)
280 : 15661 : global_dc->set_diagnostic_buffer (old_buffer);
281 : :
282 : 19470 : va_end (argp);
283 : 38940 : return ret;
284 : 19470 : }
285 : :
286 : : /* Issue a warning. */
287 : :
288 : : bool
289 : 3686 : gfc_warning (int opt, const char *gmsgid, ...)
290 : : {
291 : 3686 : va_list argp;
292 : :
293 : 3686 : va_start (argp, gmsgid);
294 : 3686 : bool ret = gfc_warning (opt, gmsgid, argp);
295 : 3686 : va_end (argp);
296 : 3686 : return ret;
297 : : }
298 : :
299 : :
300 : : /* Whether, for a feature included in a given standard set (GFC_STD_*),
301 : : we should issue an error or a warning, or be quiet. */
302 : :
303 : : notification
304 : 249837 : gfc_notification_std (int std)
305 : : {
306 : 249837 : bool warning;
307 : :
308 : 249837 : warning = ((gfc_option.warn_std & std) != 0) && !inhibit_warnings;
309 : 249837 : if ((gfc_option.allow_std & std) != 0 && !warning)
310 : : return SILENT;
311 : :
312 : 384 : return warning ? WARNING : ERROR;
313 : : }
314 : :
315 : :
316 : : /* Return a string describing the nature of a standard violation
317 : : * and/or the relevant version of the standard. */
318 : :
319 : : char const*
320 : 16490 : notify_std_msg(int std)
321 : : {
322 : :
323 : 16490 : if (std & GFC_STD_F2023_DEL)
324 : 10 : return _("Prohibited in Fortran 2023:");
325 : 16480 : else if (std & GFC_STD_F2023)
326 : 7 : return _("Fortran 2023:");
327 : 16473 : else if (std & GFC_STD_F2018_DEL)
328 : 1 : return _("Fortran 2018 deleted feature:");
329 : 16472 : else if (std & GFC_STD_F2018_OBS)
330 : 8 : return _("Fortran 2018 obsolescent feature:");
331 : 16464 : else if (std & GFC_STD_F2018)
332 : 120 : return _("Fortran 2018:");
333 : 16344 : else if (std & GFC_STD_F2008_OBS)
334 : 2 : return _("Fortran 2008 obsolescent feature:");
335 : 16342 : else if (std & GFC_STD_F2008)
336 : : return "Fortran 2008:";
337 : 15948 : else if (std & GFC_STD_F2003)
338 : : return "Fortran 2003:";
339 : 15822 : else if (std & GFC_STD_GNU)
340 : 381 : return _("GNU Extension:");
341 : 15441 : else if (std & GFC_STD_LEGACY)
342 : 11561 : return _("Legacy Extension:");
343 : 3880 : else if (std & GFC_STD_F95_OBS)
344 : 3749 : return _("Obsolescent feature:");
345 : 131 : else if (std & GFC_STD_F95_DEL)
346 : 130 : return _("Deleted feature:");
347 : 1 : else if (std & GFC_STD_UNSIGNED)
348 : 1 : return _("Unsigned:");
349 : : else
350 : 0 : gcc_unreachable ();
351 : : }
352 : :
353 : :
354 : : /* Possibly issue a warning/error about use of a nonstandard (or deleted)
355 : : feature. An error/warning will be issued if the currently selected
356 : : standard does not contain the requested bits. Return false if
357 : : an error is generated. */
358 : :
359 : : bool
360 : 322819 : gfc_notify_std (int std, const char *gmsgid, ...)
361 : : {
362 : 322819 : va_list argp;
363 : 322819 : const char *msg, *msg2;
364 : 322819 : char *buffer;
365 : :
366 : : /* Determine whether an error or a warning is needed. */
367 : 322819 : const int wstd = std & gfc_option.warn_std; /* Standard to warn about. */
368 : 322819 : const int estd = std & ~gfc_option.allow_std; /* Standard to error about. */
369 : 322819 : const bool warning = (wstd != 0) && !inhibit_warnings;
370 : 322819 : const bool error = (estd != 0);
371 : :
372 : 322819 : if (!error && !warning)
373 : : return true;
374 : 16491 : if (suppress_errors)
375 : : return !error;
376 : :
377 : 16490 : if (error)
378 : 750 : msg = notify_std_msg (estd);
379 : : else
380 : 15740 : msg = notify_std_msg (wstd);
381 : :
382 : 16490 : msg2 = _(gmsgid);
383 : 16490 : buffer = (char *) alloca (strlen (msg) + strlen (msg2) + 2);
384 : 16490 : strcpy (buffer, msg);
385 : 16490 : strcat (buffer, " ");
386 : 16490 : strcat (buffer, msg2);
387 : :
388 : 16490 : va_start (argp, gmsgid);
389 : 16490 : if (error)
390 : 750 : gfc_error_opt (0, buffer, argp);
391 : : else
392 : 15740 : gfc_warning (0, buffer, argp);
393 : 16490 : va_end (argp);
394 : :
395 : 16490 : if (error)
396 : : return false;
397 : : else
398 : 15743 : return (warning && !warnings_are_errors);
399 : : }
400 : :
401 : :
402 : : /* Called from output_format -- during diagnostic message processing
403 : : to handle Fortran specific format specifiers with the following meanings:
404 : :
405 : : %C Current locus (no argument)
406 : : %L Takes locus argument
407 : : */
408 : : static bool
409 : 1175433 : gfc_format_decoder (pretty_printer *pp, text_info *text, const char *spec,
410 : : int precision, bool wide, bool set_locus, bool hash,
411 : : bool *quoted, pp_token_list &formatted_token_list)
412 : : {
413 : 1175433 : unsigned offset = 0;
414 : 1175433 : switch (*spec)
415 : : {
416 : 1175410 : case 'C':
417 : 1175410 : case 'L':
418 : 1175410 : {
419 : 1175410 : static const char *result[2] = { "(1)", "(2)" };
420 : 1175410 : locus *loc;
421 : 1175410 : if (*spec == 'C')
422 : : {
423 : 1159228 : loc = &gfc_current_locus;
424 : : /* Point %C first offending character not the last good one. */
425 : 1159228 : if (*loc->nextc != '\0')
426 : 1098537 : offset++;
427 : : }
428 : : else
429 : 16182 : loc = va_arg (*text->m_args_ptr, locus *);
430 : :
431 : : /* If location[0] != UNKNOWN_LOCATION means that we already
432 : : processed one of %C/%L. */
433 : 1175410 : int loc_num = text->get_location (0) == UNKNOWN_LOCATION ? 0 : 1;
434 : 1175410 : location_t src_loc = gfc_get_location_with_offset (loc, offset);
435 : 1175410 : text->set_location (loc_num, src_loc, SHOW_RANGE_WITH_CARET);
436 : : /* Colorize the markers to match the color choices of
437 : : diagnostic_show_locus (the initial location has a color given
438 : : by the "kind" of the diagnostic, the secondary location has
439 : : color "range1"). */
440 : 1175410 : gcc_assert (curr_diagnostic != NULL);
441 : 1175410 : const char *color
442 : : = (loc_num
443 : 1175410 : ? "range1"
444 : 1174918 : : diagnostic_get_color_for_kind (curr_diagnostic->kind));
445 : 1175410 : pp_string (pp, colorize_start (pp_show_color (pp), color));
446 : 1175410 : pp_string (pp, result[loc_num]);
447 : 1175410 : pp_string (pp, colorize_stop (pp_show_color (pp)));
448 : 1175410 : return true;
449 : : }
450 : 23 : default:
451 : : /* Fall through info the middle-end decoder, as e.g. stor-layout.cc
452 : : etc. diagnostics can use the FE printer while the FE is still
453 : : active. */
454 : 23 : return default_tree_printer (pp, text, spec, precision, wide,
455 : : set_locus, hash, quoted,
456 : 23 : formatted_token_list);
457 : : }
458 : : }
459 : :
460 : : /* Return a malloc'd string describing the kind of diagnostic. The
461 : : caller is responsible for freeing the memory. */
462 : : static char *
463 : 1178020 : gfc_diagnostic_build_kind_prefix (diagnostic_context *context,
464 : : const diagnostic_info *diagnostic)
465 : : {
466 : 1178020 : static const char *const diagnostic_kind_text[] = {
467 : : #define DEFINE_DIAGNOSTIC_KIND(K, T, C) (T),
468 : : #include "gfc-diagnostic.def"
469 : : #undef DEFINE_DIAGNOSTIC_KIND
470 : : "must-not-happen"
471 : : };
472 : 1178020 : static const char *const diagnostic_kind_color[] = {
473 : : #define DEFINE_DIAGNOSTIC_KIND(K, T, C) (C),
474 : : #include "gfc-diagnostic.def"
475 : : #undef DEFINE_DIAGNOSTIC_KIND
476 : : NULL
477 : : };
478 : 1178020 : gcc_assert (diagnostic->kind < DK_LAST_DIAGNOSTIC_KIND);
479 : 1178020 : const char *text = _(diagnostic_kind_text[diagnostic->kind]);
480 : 1178020 : const char *text_cs = "", *text_ce = "";
481 : 1178020 : pretty_printer *const pp = context->get_reference_printer ();
482 : :
483 : 1178020 : if (diagnostic_kind_color[diagnostic->kind])
484 : : {
485 : 2356040 : text_cs = colorize_start (pp_show_color (pp),
486 : 1178020 : diagnostic_kind_color[diagnostic->kind]);
487 : 1178020 : text_ce = colorize_stop (pp_show_color (pp));
488 : : }
489 : 1178020 : return build_message_string ("%s%s:%s ", text_cs, text, text_ce);
490 : : }
491 : :
492 : : /* Return a malloc'd string describing a location. The caller is
493 : : responsible for freeing the memory. */
494 : : static char *
495 : 1178191 : gfc_diagnostic_build_locus_prefix (const diagnostic_location_print_policy &loc_policy,
496 : : expanded_location s,
497 : : bool colorize)
498 : : {
499 : 1178191 : const char *locus_cs = colorize_start (colorize, "locus");
500 : 1178191 : const char *locus_ce = colorize_stop (colorize);
501 : 1178191 : return (s.file == NULL
502 : 1178191 : ? build_message_string ("%s%s:%s", locus_cs, progname, locus_ce )
503 : 1178125 : : !strcmp (s.file, special_fname_builtin ())
504 : 1178125 : ? build_message_string ("%s%s:%s", locus_cs, s.file, locus_ce)
505 : 1178115 : : loc_policy.show_column_p ()
506 : 1178115 : ? build_message_string ("%s%s:%d:%d:%s", locus_cs, s.file, s.line,
507 : : s.column, locus_ce)
508 : 0 : : build_message_string ("%s%s:%d:%s", locus_cs, s.file, s.line, locus_ce));
509 : : }
510 : :
511 : : /* Return a malloc'd string describing two locations. The caller is
512 : : responsible for freeing the memory. */
513 : : static char *
514 : 160 : gfc_diagnostic_build_locus_prefix (const diagnostic_location_print_policy &loc_policy,
515 : : expanded_location s, expanded_location s2,
516 : : bool colorize)
517 : : {
518 : 160 : const char *locus_cs = colorize_start (colorize, "locus");
519 : 160 : const char *locus_ce = colorize_stop (colorize);
520 : :
521 : 160 : return (s.file == NULL
522 : 160 : ? build_message_string ("%s%s:%s", locus_cs, progname, locus_ce )
523 : 160 : : !strcmp (s.file, special_fname_builtin ())
524 : 160 : ? build_message_string ("%s%s:%s", locus_cs, s.file, locus_ce)
525 : 160 : : loc_policy.show_column_p ()
526 : 160 : ? build_message_string ("%s%s:%d:%d-%d:%s", locus_cs, s.file, s.line,
527 : : MIN (s.column, s2.column),
528 : : MAX (s.column, s2.column), locus_ce)
529 : 0 : : build_message_string ("%s%s:%d:%s", locus_cs, s.file, s.line,
530 : 160 : locus_ce));
531 : : }
532 : :
533 : : /* This function prints the locus (file:line:column), the diagnostic kind
534 : : (Error, Warning) and (optionally) the relevant lines of code with
535 : : annotation lines with '1' and/or '2' below them.
536 : :
537 : : With -fdiagnostic-show-caret (the default) it prints:
538 : :
539 : : [locus of primary range]:
540 : :
541 : : some code
542 : : 1
543 : : Error: Some error at (1)
544 : :
545 : : With -fno-diagnostic-show-caret or if the primary range is not
546 : : valid, it prints:
547 : :
548 : : [locus of primary range]: Error: Some error at (1) and (2)
549 : : */
550 : : static void
551 : 1178020 : gfc_diagnostic_text_starter (diagnostic_text_output_format &text_output,
552 : : const diagnostic_info *diagnostic)
553 : : {
554 : 1178020 : diagnostic_context *const context = &text_output.get_context ();
555 : 1178020 : pretty_printer *const pp = text_output.get_printer ();
556 : 1178020 : char * kind_prefix = gfc_diagnostic_build_kind_prefix (context, diagnostic);
557 : :
558 : 1178020 : expanded_location s1 = diagnostic_expand_location (diagnostic);
559 : 1178020 : expanded_location s2;
560 : 1178020 : bool one_locus = diagnostic->richloc->get_num_locations () < 2;
561 : 1178020 : bool same_locus = false;
562 : :
563 : 1178020 : if (!one_locus)
564 : : {
565 : 492 : s2 = diagnostic_expand_location (diagnostic, 1);
566 : 984 : same_locus = diagnostic_same_line (context, s1, s2);
567 : : }
568 : :
569 : 1178020 : diagnostic_location_print_policy loc_policy (text_output);
570 : 1178020 : const bool colorize = pp_show_color (pp);
571 : 1178020 : char * locus_prefix = (one_locus || !same_locus)
572 : 1178020 : ? gfc_diagnostic_build_locus_prefix (loc_policy, s1, colorize)
573 : 160 : : gfc_diagnostic_build_locus_prefix (loc_policy, s1, s2, colorize);
574 : :
575 : 1178020 : if (!context->m_source_printing.enabled
576 : 16190 : || diagnostic_location (diagnostic, 0) <= BUILTINS_LOCATION
577 : 1194210 : || diagnostic_location (diagnostic, 0) == context->m_last_location)
578 : : {
579 : 1161830 : pp_set_prefix (pp,
580 : : concat (locus_prefix, " ", kind_prefix, NULL));
581 : 1161830 : free (locus_prefix);
582 : :
583 : 1161830 : if (one_locus || same_locus)
584 : : {
585 : 1161500 : free (kind_prefix);
586 : 1161500 : return;
587 : : }
588 : : /* In this case, we print the previous locus and prefix as:
589 : :
590 : : [locus]:[prefix]: (1)
591 : :
592 : : and we flush with a new line before setting the new prefix. */
593 : 330 : pp_string (pp, "(1)");
594 : 330 : pp_newline (pp);
595 : 330 : locus_prefix = gfc_diagnostic_build_locus_prefix (loc_policy, s2, colorize);
596 : 330 : pp_set_prefix (pp,
597 : : concat (locus_prefix, " ", kind_prefix, NULL));
598 : 330 : free (kind_prefix);
599 : 330 : free (locus_prefix);
600 : : }
601 : : else
602 : : {
603 : 16190 : pp_verbatim (pp, "%s", locus_prefix);
604 : 16190 : free (locus_prefix);
605 : : /* Fortran uses an empty line between locus and caret line. */
606 : 16190 : pp_newline (pp);
607 : 16190 : pp_set_prefix (pp, NULL);
608 : 16190 : pp_newline (pp);
609 : 16190 : diagnostic_show_locus (context,
610 : 16190 : text_output.get_source_printing_options (),
611 : 16190 : diagnostic->richloc, diagnostic->kind,
612 : : pp);
613 : : /* If the caret line was shown, the prefix does not contain the
614 : : locus. */
615 : 16190 : pp_set_prefix (pp, kind_prefix);
616 : : }
617 : : }
618 : :
619 : : static void
620 : 1 : gfc_diagnostic_start_span (const diagnostic_location_print_policy &loc_policy,
621 : : pretty_printer *pp,
622 : : expanded_location exploc)
623 : : {
624 : 1 : const bool colorize = pp_show_color (pp);
625 : 1 : char *locus_prefix
626 : 1 : = gfc_diagnostic_build_locus_prefix (loc_policy, exploc, colorize);
627 : 1 : pp_verbatim (pp, "%s", locus_prefix);
628 : 1 : free (locus_prefix);
629 : 1 : pp_newline (pp);
630 : : /* Fortran uses an empty line between locus and caret line. */
631 : 1 : pp_newline (pp);
632 : 1 : }
633 : :
634 : :
635 : : static void
636 : 1178020 : gfc_diagnostic_text_finalizer (diagnostic_text_output_format &text_output,
637 : : const diagnostic_info *diagnostic ATTRIBUTE_UNUSED,
638 : : diagnostic_t orig_diag_kind ATTRIBUTE_UNUSED)
639 : : {
640 : 1178020 : pretty_printer *const pp = text_output.get_printer ();
641 : 1178020 : pp_destroy_prefix (pp);
642 : 1178020 : pp_newline_and_flush (pp);
643 : 1178020 : }
644 : :
645 : : /* Immediate warning (i.e. do not buffer the warning) with an explicit
646 : : location. */
647 : :
648 : : bool
649 : 3 : gfc_warning_now_at (location_t loc, int opt, const char *gmsgid, ...)
650 : : {
651 : 3 : va_list argp;
652 : 3 : diagnostic_info diagnostic;
653 : 3 : rich_location rich_loc (line_table, loc);
654 : 3 : bool ret;
655 : :
656 : 3 : va_start (argp, gmsgid);
657 : 3 : diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc, DK_WARNING);
658 : 3 : diagnostic.option_id = opt;
659 : 3 : ret = gfc_report_diagnostic (&diagnostic);
660 : 3 : va_end (argp);
661 : 6 : return ret;
662 : 3 : }
663 : :
664 : : /* Immediate warning (i.e. do not buffer the warning). */
665 : :
666 : : bool
667 : 25999 : gfc_warning_now (int opt, const char *gmsgid, ...)
668 : : {
669 : 25999 : va_list argp;
670 : 25999 : diagnostic_info diagnostic;
671 : 25999 : rich_location rich_loc (line_table, UNKNOWN_LOCATION);
672 : 25999 : bool ret;
673 : :
674 : 25999 : va_start (argp, gmsgid);
675 : 25999 : diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc,
676 : : DK_WARNING);
677 : 25999 : diagnostic.option_id = opt;
678 : 25999 : ret = gfc_report_diagnostic (&diagnostic);
679 : 25999 : va_end (argp);
680 : 51998 : return ret;
681 : 25999 : }
682 : :
683 : : /* Internal warning, do not buffer. */
684 : :
685 : : bool
686 : 0 : gfc_warning_internal (int opt, const char *gmsgid, ...)
687 : : {
688 : 0 : va_list argp;
689 : 0 : diagnostic_info diagnostic;
690 : 0 : rich_location rich_loc (line_table, UNKNOWN_LOCATION);
691 : 0 : bool ret;
692 : :
693 : 0 : va_start (argp, gmsgid);
694 : 0 : diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc,
695 : : DK_WARNING);
696 : 0 : diagnostic.option_id = opt;
697 : 0 : ret = gfc_report_diagnostic (&diagnostic);
698 : 0 : va_end (argp);
699 : 0 : return ret;
700 : 0 : }
701 : :
702 : : /* Immediate error (i.e. do not buffer). */
703 : :
704 : : void
705 : 426 : gfc_error_now (const char *gmsgid, ...)
706 : : {
707 : 426 : va_list argp;
708 : 426 : diagnostic_info diagnostic;
709 : 426 : rich_location rich_loc (line_table, UNKNOWN_LOCATION);
710 : :
711 : 426 : error_buffer->flag = true;
712 : :
713 : 426 : va_start (argp, gmsgid);
714 : 426 : diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc, DK_ERROR);
715 : 426 : gfc_report_diagnostic (&diagnostic);
716 : 426 : va_end (argp);
717 : 426 : }
718 : :
719 : :
720 : : /* Fatal error, never returns. */
721 : :
722 : : void
723 : 8 : gfc_fatal_error (const char *gmsgid, ...)
724 : : {
725 : 8 : va_list argp;
726 : 8 : diagnostic_info diagnostic;
727 : 8 : rich_location rich_loc (line_table, UNKNOWN_LOCATION);
728 : :
729 : 8 : va_start (argp, gmsgid);
730 : 8 : diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc, DK_FATAL);
731 : 8 : gfc_report_diagnostic (&diagnostic);
732 : 0 : va_end (argp);
733 : :
734 : 0 : gcc_unreachable ();
735 : : }
736 : :
737 : : /* Clear the warning flag. */
738 : :
739 : : void
740 : 12774351 : gfc_clear_warning (void)
741 : : {
742 : 12774351 : gfc_clear_diagnostic_buffer (pp_warning_buffer);
743 : 12774351 : }
744 : :
745 : :
746 : : /* Check to see if any warnings have been saved.
747 : : If so, print the warning. */
748 : :
749 : : void
750 : 1349996 : gfc_warning_check (void)
751 : : {
752 : 1349996 : if (! pp_warning_buffer->empty_p ())
753 : 3959 : global_dc->flush_diagnostic_buffer (*pp_warning_buffer);
754 : 1349996 : }
755 : :
756 : :
757 : : /* Issue an error. */
758 : :
759 : : static void
760 : 1173182 : gfc_error_opt (int opt, const char *gmsgid, va_list ap)
761 : : {
762 : 1173182 : va_list argp;
763 : 1173182 : va_copy (argp, ap);
764 : :
765 : 1173182 : if (warnings_not_errors)
766 : : {
767 : 44 : gfc_warning (opt, gmsgid, argp);
768 : 44 : va_end (argp);
769 : 17249 : return;
770 : : }
771 : :
772 : 1173138 : if (suppress_errors)
773 : : {
774 : 17205 : va_end (argp);
775 : 17205 : return;
776 : : }
777 : :
778 : 1155933 : diagnostic_info diagnostic;
779 : 1155933 : rich_location richloc (line_table, UNKNOWN_LOCATION);
780 : 1155933 : diagnostic_buffer *old_buffer = global_dc->get_diagnostic_buffer ();
781 : 1155933 : gcc_assert (!old_buffer);
782 : :
783 : 1155933 : gfc_clear_diagnostic_buffer (pp_error_buffer);
784 : :
785 : 1155933 : if (buffered_p)
786 : 1149021 : global_dc->set_diagnostic_buffer (pp_error_buffer);
787 : :
788 : 1155933 : diagnostic_set_info (&diagnostic, gmsgid, &argp, &richloc, DK_ERROR);
789 : 1155933 : gfc_report_diagnostic (&diagnostic);
790 : :
791 : 1155933 : if (buffered_p)
792 : 1149021 : global_dc->set_diagnostic_buffer (old_buffer);
793 : :
794 : 1155933 : va_end (argp);
795 : 1155933 : }
796 : :
797 : :
798 : : void
799 : 251 : gfc_error_opt (int opt, const char *gmsgid, ...)
800 : : {
801 : 251 : va_list argp;
802 : 251 : va_start (argp, gmsgid);
803 : 251 : gfc_error_opt (opt, gmsgid, argp);
804 : 251 : va_end (argp);
805 : 251 : }
806 : :
807 : :
808 : : void
809 : 1172181 : gfc_error (const char *gmsgid, ...)
810 : : {
811 : 1172181 : va_list argp;
812 : 1172181 : va_start (argp, gmsgid);
813 : 1172181 : gfc_error_opt (0, gmsgid, argp);
814 : 1172181 : va_end (argp);
815 : 1172181 : }
816 : :
817 : :
818 : : /* This shouldn't happen... but sometimes does. */
819 : :
820 : : void
821 : 0 : gfc_internal_error (const char *gmsgid, ...)
822 : : {
823 : 0 : int e, w;
824 : 0 : va_list argp;
825 : 0 : diagnostic_info diagnostic;
826 : 0 : rich_location rich_loc (line_table, UNKNOWN_LOCATION);
827 : :
828 : 0 : gfc_get_errors (&w, &e);
829 : 0 : if (e > 0)
830 : 0 : exit(EXIT_FAILURE);
831 : :
832 : 0 : va_start (argp, gmsgid);
833 : 0 : diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc, DK_ICE);
834 : 0 : gfc_report_diagnostic (&diagnostic);
835 : 0 : va_end (argp);
836 : :
837 : 0 : gcc_unreachable ();
838 : : }
839 : :
840 : :
841 : : /* Clear the error flag when we start to compile a source line. */
842 : :
843 : : void
844 : 4903645 : gfc_clear_error (void)
845 : : {
846 : 4903645 : error_buffer->flag = false;
847 : 4903645 : warnings_not_errors = false;
848 : 4903645 : gfc_clear_diagnostic_buffer (pp_error_buffer);
849 : 4903645 : }
850 : :
851 : :
852 : : /* Tests the state of error_flag. */
853 : :
854 : : bool
855 : 1563609 : gfc_error_flag_test (void)
856 : : {
857 : 1563609 : return (error_buffer->flag
858 : 1563609 : || !pp_error_buffer->empty_p ());
859 : : }
860 : :
861 : :
862 : : /* Check to see if any errors have been saved.
863 : : If so, print the error. Returns the state of error_flag. */
864 : :
865 : : bool
866 : 5367 : gfc_error_check (void)
867 : : {
868 : 5367 : if (error_buffer->flag
869 : 5367 : || ! pp_error_buffer->empty_p ())
870 : : {
871 : 3123 : error_buffer->flag = false;
872 : 3123 : global_dc->flush_diagnostic_buffer (*pp_error_buffer);
873 : 3123 : return true;
874 : : }
875 : :
876 : : return false;
877 : : }
878 : :
879 : : /* Move the text buffered from FROM to TO, then clear
880 : : FROM. Independently if there was text in FROM, TO is also
881 : : cleared. */
882 : :
883 : : static void
884 : 2918636 : gfc_move_error_buffer_from_to (gfc_error_buffer * buffer_from,
885 : : gfc_error_buffer * buffer_to)
886 : : {
887 : 2918636 : diagnostic_buffer * from = &(buffer_from->buffer);
888 : 2918636 : diagnostic_buffer * to = &(buffer_to->buffer);
889 : :
890 : 2918636 : buffer_to->flag = buffer_from->flag;
891 : 2918636 : buffer_from->flag = false;
892 : :
893 : 2918636 : gfc_clear_diagnostic_buffer (to);
894 : :
895 : 2918636 : if (! from->empty_p ())
896 : : {
897 : 101957 : from->move_to (*to);
898 : 101957 : gfc_clear_diagnostic_buffer (from);
899 : : }
900 : 2918636 : }
901 : :
902 : : /* Save the existing error state. */
903 : :
904 : : void
905 : 1496458 : gfc_push_error (gfc_error_buffer *err)
906 : : {
907 : 1496458 : gfc_move_error_buffer_from_to (error_buffer, err);
908 : 1496458 : }
909 : :
910 : :
911 : : /* Restore a previous pushed error state. */
912 : :
913 : : void
914 : 1422178 : gfc_pop_error (gfc_error_buffer *err)
915 : : {
916 : 1422178 : gfc_move_error_buffer_from_to (err, error_buffer);
917 : 1422178 : }
918 : :
919 : :
920 : : /* Free a pushed error state, but keep the current error state. */
921 : :
922 : : void
923 : 74108 : gfc_free_error (gfc_error_buffer *err)
924 : : {
925 : 74108 : gfc_clear_diagnostic_buffer (&(err->buffer));
926 : 74108 : }
927 : :
928 : :
929 : : /* Report the number of warnings and errors that occurred to the caller. */
930 : :
931 : : void
932 : 343852 : gfc_get_errors (int *w, int *e)
933 : : {
934 : 343852 : if (w != NULL)
935 : 294369 : *w = warningcount + werrorcount;
936 : 343852 : if (e != NULL)
937 : 343852 : *e = errorcount + sorrycount + werrorcount;
938 : 343852 : }
939 : :
940 : :
941 : : /* Switch errors into warnings. */
942 : :
943 : : void
944 : 48175 : gfc_errors_to_warnings (bool f)
945 : : {
946 : 48175 : warnings_not_errors = f;
947 : 48175 : }
948 : :
949 : : void
950 : 30445 : gfc_diagnostics_init (void)
951 : : {
952 : 30445 : diagnostic_text_starter (global_dc) = gfc_diagnostic_text_starter;
953 : 30445 : diagnostic_start_span (global_dc) = gfc_diagnostic_start_span;
954 : 30445 : diagnostic_text_finalizer (global_dc) = gfc_diagnostic_text_finalizer;
955 : 30445 : global_dc->set_format_decoder (gfc_format_decoder);
956 : 30445 : global_dc->m_source_printing.caret_chars[0] = '1';
957 : 30445 : global_dc->m_source_printing.caret_chars[1] = '2';
958 : 30445 : pp_warning_buffer = new diagnostic_buffer (*global_dc);
959 : 30445 : error_buffer = new gfc_error_buffer ();
960 : 30445 : pp_error_buffer = &(error_buffer->buffer);
961 : 30445 : }
962 : :
963 : : void
964 : 30418 : gfc_diagnostics_finish (void)
965 : : {
966 : 30418 : tree_diagnostics_defaults (global_dc);
967 : : /* We still want to use the gfc starter and finalizer, not the tree
968 : : defaults. */
969 : 30418 : diagnostic_text_starter (global_dc) = gfc_diagnostic_text_starter;
970 : 30418 : diagnostic_text_finalizer (global_dc) = gfc_diagnostic_text_finalizer;
971 : 30418 : global_dc->m_source_printing.caret_chars[0] = '^';
972 : 30418 : global_dc->m_source_printing.caret_chars[1] = '^';
973 : 60836 : delete error_buffer;
974 : 30418 : error_buffer = nullptr;
975 : 30418 : pp_error_buffer = nullptr;
976 : 30418 : }
|
