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 "diagnostics/color.h"
35 : : #include "tree-diagnostic.h" /* tree_diagnostics_defaults */
36 : : #include "diagnostics/text-sink.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 diagnostics::buffer *pp_error_buffer, *pp_warning_buffer;
47 : :
48 : 8355689 : gfc_error_buffer::gfc_error_buffer ()
49 : 8355689 : : flag (false), buffer (*global_dc)
50 : : {
51 : 8355689 : }
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 : 19927413 : gfc_get_location_with_offset (locus *loc, unsigned offset)
61 : : {
62 : 19927413 : if (loc->nextc == (gfc_char_t *) -1)
63 : : {
64 : 401167 : gcc_checking_assert (offset == 0);
65 : 401167 : return loc->u.location;
66 : : }
67 : 19526246 : gcc_checking_assert (loc->nextc >= loc->u.lb->line);
68 : 19526246 : return linemap_position_for_loc_and_offset (line_table, loc->u.lb->location,
69 : 19526246 : loc->nextc - loc->u.lb->line
70 : 19526246 : + offset);
71 : : }
72 : :
73 : : /* Convert a locus to a range. */
74 : :
75 : : locus
76 : 7520468 : gfc_get_location_range (locus *caret_loc, unsigned caret_offset,
77 : : locus *start_loc, unsigned start_offset,
78 : : locus *end_loc)
79 : : {
80 : 7520468 : location_t caret;
81 : 7520468 : location_t start = gfc_get_location_with_offset (start_loc, start_offset);
82 : 7520468 : location_t end = gfc_get_location_with_offset (end_loc, 0);
83 : :
84 : 7520468 : 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 : 7520468 : range.u.location = make_location (caret_loc ? caret : start, start, end);
90 : 7520468 : return range;
91 : : }
92 : :
93 : : /* Return buffered_p. */
94 : : bool
95 : 78 : gfc_buffered_p (void)
96 : : {
97 : 78 : return buffered_p;
98 : : }
99 : :
100 : : /* Go one level deeper suppressing errors. */
101 : :
102 : : void
103 : 456724 : gfc_push_suppress_errors (void)
104 : : {
105 : 456724 : gcc_assert (suppress_errors >= 0);
106 : 456724 : ++suppress_errors;
107 : 456724 : }
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 : 456724 : gfc_pop_suppress_errors (void)
120 : : {
121 : 456724 : gcc_assert (suppress_errors > 0);
122 : 456724 : --suppress_errors;
123 : 456724 : }
124 : :
125 : :
126 : : /* Query whether errors are suppressed. */
127 : :
128 : : bool
129 : 146 : gfc_query_suppress_errors (void)
130 : : {
131 : 146 : return suppress_errors > 0;
132 : : }
133 : :
134 : :
135 : : /* Per-file error initialization. */
136 : :
137 : : void
138 : 30819 : gfc_error_init_1 (void)
139 : : {
140 : 30819 : gfc_buffer_error (false);
141 : 30819 : }
142 : :
143 : :
144 : : /* Set the flag for buffering errors or not. */
145 : :
146 : : void
147 : 6230125 : gfc_buffer_error (bool flag)
148 : : {
149 : 6230125 : buffered_p = flag;
150 : 6230125 : }
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 : 22829475 : gfc_clear_diagnostic_buffer (diagnostics::buffer *this_buffer)
232 : : {
233 : 22829475 : gcc_assert (this_buffer);
234 : 22829475 : global_dc->clear_diagnostic_buffer (*this_buffer);
235 : 22829475 : }
236 : :
237 : : /* The currently-printing diagnostic, for use by gfc_format_decoder,
238 : : for colorizing %C and %L. */
239 : :
240 : : static diagnostics::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 : 1229710 : gfc_report_diagnostic (diagnostics::diagnostic_info *diagnostic)
247 : : {
248 : 1229710 : gcc_assert (diagnostic != NULL);
249 : 1229710 : curr_diagnostic = diagnostic;
250 : 1229710 : bool ret = diagnostic_report_diagnostic (global_dc, diagnostic);
251 : 1229700 : curr_diagnostic = NULL;
252 : 1229700 : 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 : 20254 : gfc_warning (int opt, const char *gmsgid, va_list ap)
260 : : {
261 : 20254 : va_list argp;
262 : 20254 : va_copy (argp, ap);
263 : :
264 : 20254 : diagnostics::diagnostic_info diagnostic;
265 : 20254 : rich_location rich_loc (line_table, UNKNOWN_LOCATION);
266 : 20254 : diagnostics::buffer *old_buffer = global_dc->get_diagnostic_buffer ();
267 : 20254 : gcc_assert (!old_buffer);
268 : :
269 : 20254 : gfc_clear_diagnostic_buffer (pp_warning_buffer);
270 : :
271 : 20254 : if (buffered_p)
272 : 15978 : global_dc->set_diagnostic_buffer (pp_warning_buffer);
273 : :
274 : 20254 : diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc,
275 : : diagnostics::kind::warning);
276 : 20254 : diagnostic.m_option_id = opt;
277 : 20254 : bool ret = gfc_report_diagnostic (&diagnostic);
278 : :
279 : 20254 : if (buffered_p)
280 : 15978 : global_dc->set_diagnostic_buffer (old_buffer);
281 : :
282 : 20254 : va_end (argp);
283 : 40508 : return ret;
284 : 20254 : }
285 : :
286 : : /* Issue a warning. */
287 : :
288 : : bool
289 : 4409 : gfc_warning (int opt, const char *gmsgid, ...)
290 : : {
291 : 4409 : va_list argp;
292 : :
293 : 4409 : va_start (argp, gmsgid);
294 : 4409 : bool ret = gfc_warning (opt, gmsgid, argp);
295 : 4409 : va_end (argp);
296 : 4409 : 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 : 253657 : gfc_notification_std (int std)
305 : : {
306 : 253657 : bool warning;
307 : :
308 : 253657 : warning = ((gfc_option.warn_std & std) != 0) && !inhibit_warnings;
309 : 253657 : if ((gfc_option.allow_std & std) != 0 && !warning)
310 : : return SILENT;
311 : :
312 : 442 : 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 : 16541 : notify_std_msg(int std)
321 : : {
322 : :
323 : 16541 : if (std & GFC_STD_F2023_DEL)
324 : 10 : return _("Prohibited in Fortran 2023:");
325 : 16531 : else if (std & GFC_STD_F2023)
326 : 9 : return _("Fortran 2023:");
327 : 16522 : else if (std & GFC_STD_F2018_DEL)
328 : 1 : return _("Fortran 2018 deleted feature:");
329 : 16521 : else if (std & GFC_STD_F2018_OBS)
330 : 8 : return _("Fortran 2018 obsolescent feature:");
331 : 16513 : else if (std & GFC_STD_F2018)
332 : 119 : return _("Fortran 2018:");
333 : 16394 : else if (std & GFC_STD_F2008_OBS)
334 : 2 : return _("Fortran 2008 obsolescent feature:");
335 : 16392 : else if (std & GFC_STD_F2008)
336 : : return "Fortran 2008:";
337 : 16004 : else if (std & GFC_STD_F2003)
338 : : return "Fortran 2003:";
339 : 15879 : else if (std & GFC_STD_GNU)
340 : 378 : return _("GNU Extension:");
341 : 15501 : else if (std & GFC_STD_LEGACY)
342 : 11560 : return _("Legacy Extension:");
343 : 3941 : else if (std & GFC_STD_F95_OBS)
344 : 3810 : 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 : 335436 : gfc_notify_std (int std, const char *gmsgid, ...)
361 : : {
362 : 335436 : va_list argp;
363 : 335436 : const char *msg, *msg2;
364 : 335436 : char *buffer;
365 : :
366 : : /* Determine whether an error or a warning is needed. */
367 : 335436 : const int wstd = std & gfc_option.warn_std; /* Standard to warn about. */
368 : 335436 : const int estd = std & ~gfc_option.allow_std; /* Standard to error about. */
369 : 335436 : const bool warning = (wstd != 0) && !inhibit_warnings;
370 : 335436 : const bool error = (estd != 0);
371 : :
372 : 335436 : if (!error && !warning)
373 : : return true;
374 : 16542 : if (suppress_errors)
375 : : return !error;
376 : :
377 : 16541 : if (error)
378 : 740 : msg = notify_std_msg (estd);
379 : : else
380 : 15801 : msg = notify_std_msg (wstd);
381 : :
382 : 16541 : msg2 = _(gmsgid);
383 : 16541 : buffer = (char *) alloca (strlen (msg) + strlen (msg2) + 2);
384 : 16541 : strcpy (buffer, msg);
385 : 16541 : strcat (buffer, " ");
386 : 16541 : strcat (buffer, msg2);
387 : :
388 : 16541 : va_start (argp, gmsgid);
389 : 16541 : if (error)
390 : 740 : gfc_error_opt (0, buffer, argp);
391 : : else
392 : 15801 : gfc_warning (0, buffer, argp);
393 : 16541 : va_end (argp);
394 : :
395 : 16541 : if (error)
396 : : return false;
397 : : else
398 : 15804 : 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 : 1201940 : 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 : 1201940 : unsigned offset = 0;
414 : 1201940 : switch (*spec)
415 : : {
416 : 1201917 : case 'C':
417 : 1201917 : case 'L':
418 : 1201917 : {
419 : 1201917 : static const char *result[2] = { "(1)", "(2)" };
420 : 1201917 : locus *loc;
421 : 1201917 : if (*spec == 'C')
422 : : {
423 : 1185068 : loc = &gfc_current_locus;
424 : : /* Point %C first offending character not the last good one. */
425 : 1185068 : if (*loc->nextc != '\0')
426 : 1122259 : offset++;
427 : : }
428 : : else
429 : 16849 : 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 : 1201917 : int loc_num = text->get_location (0) == UNKNOWN_LOCATION ? 0 : 1;
434 : 1201917 : location_t src_loc = gfc_get_location_with_offset (loc, offset);
435 : 1201917 : 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 : 1201917 : gcc_assert (curr_diagnostic != NULL);
441 : 1201917 : const char *color
442 : : = (loc_num
443 : 1201917 : ? "range1"
444 : 1201401 : : diagnostics::get_color_for_kind (curr_diagnostic->m_kind));
445 : 1201917 : pp_string (pp, colorize_start (pp_show_color (pp), color));
446 : 1201917 : pp_string (pp, result[loc_num]);
447 : 1201917 : pp_string (pp, colorize_stop (pp_show_color (pp)));
448 : 1201917 : 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 : 1204469 : gfc_diagnostic_build_kind_prefix (diagnostics::context *context,
464 : : const diagnostics::diagnostic_info *diagnostic)
465 : : {
466 : 1204469 : 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 : 1204469 : 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 : 1204469 : const int diag_kind_idx = static_cast<int> (diagnostic->m_kind);
479 : 1204469 : gcc_assert (diagnostic->m_kind < diagnostics::kind::last_diagnostic_kind);
480 : 1204469 : const char *text = _(diagnostic_kind_text[diag_kind_idx]);
481 : 1204469 : const char *text_cs = "", *text_ce = "";
482 : 1204469 : pretty_printer *const pp = context->get_reference_printer ();
483 : :
484 : 1204469 : if (diagnostic_kind_color[diag_kind_idx])
485 : : {
486 : 2408938 : text_cs = colorize_start (pp_show_color (pp),
487 : 1204469 : diagnostic_kind_color[diag_kind_idx]);
488 : 1204469 : text_ce = colorize_stop (pp_show_color (pp));
489 : : }
490 : 1204469 : return build_message_string ("%s%s:%s ", text_cs, text, text_ce);
491 : : }
492 : :
493 : : /* Return a malloc'd string describing a location. The caller is
494 : : responsible for freeing the memory. */
495 : : static char *
496 : 1204626 : gfc_diagnostic_build_locus_prefix (const diagnostics::location_print_policy &loc_policy,
497 : : expanded_location s,
498 : : bool colorize)
499 : : {
500 : 1204626 : const char *locus_cs = colorize_start (colorize, "locus");
501 : 1204626 : const char *locus_ce = colorize_stop (colorize);
502 : 1204626 : return (s.file == NULL
503 : 1204626 : ? build_message_string ("%s%s:%s", locus_cs, progname, locus_ce )
504 : 1204535 : : !strcmp (s.file, special_fname_builtin ())
505 : 1204535 : ? build_message_string ("%s%s:%s", locus_cs, s.file, locus_ce)
506 : 1204525 : : loc_policy.show_column_p ()
507 : 1204525 : ? build_message_string ("%s%s:%d:%d:%s", locus_cs, s.file, s.line,
508 : : s.column, locus_ce)
509 : 0 : : build_message_string ("%s%s:%d:%s", locus_cs, s.file, s.line, locus_ce));
510 : : }
511 : :
512 : : /* Return a malloc'd string describing two locations. The caller is
513 : : responsible for freeing the memory. */
514 : : static char *
515 : 179 : gfc_diagnostic_build_locus_prefix (const diagnostics::location_print_policy &loc_policy,
516 : : expanded_location s, expanded_location s2,
517 : : bool colorize)
518 : : {
519 : 179 : const char *locus_cs = colorize_start (colorize, "locus");
520 : 179 : const char *locus_ce = colorize_stop (colorize);
521 : :
522 : 179 : return (s.file == NULL
523 : 179 : ? build_message_string ("%s%s:%s", locus_cs, progname, locus_ce )
524 : 179 : : !strcmp (s.file, special_fname_builtin ())
525 : 179 : ? build_message_string ("%s%s:%s", locus_cs, s.file, locus_ce)
526 : 179 : : loc_policy.show_column_p ()
527 : 179 : ? build_message_string ("%s%s:%d:%d-%d:%s", locus_cs, s.file, s.line,
528 : : MIN (s.column, s2.column),
529 : : MAX (s.column, s2.column), locus_ce)
530 : 0 : : build_message_string ("%s%s:%d:%s", locus_cs, s.file, s.line,
531 : 179 : locus_ce));
532 : : }
533 : :
534 : : /* This function prints the locus (file:line:column), the diagnostic kind
535 : : (Error, Warning) and (optionally) the relevant lines of code with
536 : : annotation lines with '1' and/or '2' below them.
537 : :
538 : : With -fdiagnostic-show-caret (the default) it prints:
539 : :
540 : : [locus of primary range]:
541 : :
542 : : some code
543 : : 1
544 : : Error: Some error at (1)
545 : :
546 : : With -fno-diagnostic-show-caret or if the primary range is not
547 : : valid, it prints:
548 : :
549 : : [locus of primary range]: Error: Some error at (1) and (2)
550 : : */
551 : : static void
552 : 1204469 : gfc_diagnostic_text_starter (diagnostics::text_sink &text_output,
553 : : const diagnostics::diagnostic_info *diagnostic)
554 : : {
555 : 1204469 : diagnostics::context *const context = &text_output.get_context ();
556 : 1204469 : pretty_printer *const pp = text_output.get_printer ();
557 : 1204469 : char * kind_prefix = gfc_diagnostic_build_kind_prefix (context, diagnostic);
558 : :
559 : 1204469 : expanded_location s1 = diagnostic_expand_location (diagnostic);
560 : 1204469 : expanded_location s2;
561 : 1204469 : bool one_locus = diagnostic->m_richloc->get_num_locations () < 2;
562 : 1204469 : bool same_locus = false;
563 : :
564 : 1204469 : if (!one_locus)
565 : : {
566 : 516 : s2 = diagnostic_expand_location (diagnostic, 1);
567 : 1032 : same_locus = diagnostic_same_line (context, s1, s2);
568 : : }
569 : :
570 : 1204469 : diagnostics::location_print_policy loc_policy (text_output);
571 : 1204469 : const bool colorize = pp_show_color (pp);
572 : 1204469 : char * locus_prefix = (one_locus || !same_locus)
573 : 1204469 : ? gfc_diagnostic_build_locus_prefix (loc_policy, s1, colorize)
574 : 179 : : gfc_diagnostic_build_locus_prefix (loc_policy, s1, s2, colorize);
575 : :
576 : 1204469 : if (!context->get_source_printing_options ().enabled
577 : 16752 : || diagnostic_location (diagnostic, 0) <= BUILTINS_LOCATION
578 : 1221221 : || diagnostic_location (diagnostic, 0) == context->m_last_location)
579 : : {
580 : 1187717 : pp_set_prefix (pp,
581 : : concat (locus_prefix, " ", kind_prefix, NULL));
582 : 1187717 : free (locus_prefix);
583 : :
584 : 1187717 : if (one_locus || same_locus)
585 : : {
586 : 1187382 : free (kind_prefix);
587 : 1187382 : return;
588 : : }
589 : : /* In this case, we print the previous locus and prefix as:
590 : :
591 : : [locus]:[prefix]: (1)
592 : :
593 : : and we flush with a new line before setting the new prefix. */
594 : 335 : pp_string (pp, "(1)");
595 : 335 : pp_newline (pp);
596 : 335 : locus_prefix = gfc_diagnostic_build_locus_prefix (loc_policy, s2, colorize);
597 : 335 : pp_set_prefix (pp,
598 : : concat (locus_prefix, " ", kind_prefix, NULL));
599 : 335 : free (kind_prefix);
600 : 335 : free (locus_prefix);
601 : : }
602 : : else
603 : : {
604 : 16752 : pp_verbatim (pp, "%s", locus_prefix);
605 : 16752 : free (locus_prefix);
606 : : /* Fortran uses an empty line between locus and caret line. */
607 : 16752 : pp_newline (pp);
608 : 16752 : pp_set_prefix (pp, NULL);
609 : 16752 : pp_newline (pp);
610 : 16752 : diagnostic_show_locus (context,
611 : 16752 : text_output.get_source_printing_options (),
612 : 16752 : diagnostic->m_richloc, diagnostic->m_kind,
613 : : pp);
614 : : /* If the caret line was shown, the prefix does not contain the
615 : : locus. */
616 : 16752 : pp_set_prefix (pp, kind_prefix);
617 : : }
618 : : }
619 : :
620 : : static void
621 : 1 : gfc_diagnostic_start_span (const diagnostics::location_print_policy &loc_policy,
622 : : diagnostics::to_text &sink,
623 : : expanded_location exploc)
624 : : {
625 : 1 : pretty_printer *pp = diagnostics::get_printer (sink);
626 : 1 : const bool colorize = pp_show_color (pp);
627 : 1 : char *locus_prefix
628 : 1 : = gfc_diagnostic_build_locus_prefix (loc_policy, exploc, colorize);
629 : 1 : pp_verbatim (pp, "%s", locus_prefix);
630 : 1 : free (locus_prefix);
631 : 1 : pp_newline (pp);
632 : : /* Fortran uses an empty line between locus and caret line. */
633 : 1 : pp_newline (pp);
634 : 1 : }
635 : :
636 : :
637 : : static void
638 : 1204469 : gfc_diagnostic_text_finalizer (diagnostics::text_sink &text_output,
639 : : const diagnostics::diagnostic_info *,
640 : : enum diagnostics::kind orig_diag_kind ATTRIBUTE_UNUSED)
641 : : {
642 : 1204469 : pretty_printer *const pp = text_output.get_printer ();
643 : 1204469 : pp_destroy_prefix (pp);
644 : 1204469 : pp_newline_and_flush (pp);
645 : 1204469 : }
646 : :
647 : : /* Immediate warning (i.e. do not buffer the warning) with an explicit
648 : : location. */
649 : :
650 : : bool
651 : 3 : gfc_warning_now_at (location_t loc, int opt, const char *gmsgid, ...)
652 : : {
653 : 3 : va_list argp;
654 : 3 : diagnostics::diagnostic_info diagnostic;
655 : 3 : rich_location rich_loc (line_table, loc);
656 : 3 : bool ret;
657 : :
658 : 3 : va_start (argp, gmsgid);
659 : 3 : diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc,
660 : : diagnostics::kind::warning);
661 : 3 : diagnostic.m_option_id = opt;
662 : 3 : ret = gfc_report_diagnostic (&diagnostic);
663 : 3 : va_end (argp);
664 : 6 : return ret;
665 : 3 : }
666 : :
667 : : /* Immediate warning (i.e. do not buffer the warning). */
668 : :
669 : : bool
670 : 26907 : gfc_warning_now (int opt, const char *gmsgid, ...)
671 : : {
672 : 26907 : va_list argp;
673 : 26907 : diagnostics::diagnostic_info diagnostic;
674 : 26907 : rich_location rich_loc (line_table, UNKNOWN_LOCATION);
675 : 26907 : bool ret;
676 : :
677 : 26907 : va_start (argp, gmsgid);
678 : 26907 : diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc,
679 : : diagnostics::kind::warning);
680 : 26907 : diagnostic.m_option_id = opt;
681 : 26907 : ret = gfc_report_diagnostic (&diagnostic);
682 : 26907 : va_end (argp);
683 : 53814 : return ret;
684 : 26907 : }
685 : :
686 : : /* Internal warning, do not buffer. */
687 : :
688 : : bool
689 : 0 : gfc_warning_internal (int opt, const char *gmsgid, ...)
690 : : {
691 : 0 : va_list argp;
692 : 0 : diagnostics::diagnostic_info diagnostic;
693 : 0 : rich_location rich_loc (line_table, UNKNOWN_LOCATION);
694 : 0 : bool ret;
695 : :
696 : 0 : va_start (argp, gmsgid);
697 : 0 : diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc,
698 : : diagnostics::kind::warning);
699 : 0 : diagnostic.m_option_id = opt;
700 : 0 : ret = gfc_report_diagnostic (&diagnostic);
701 : 0 : va_end (argp);
702 : 0 : return ret;
703 : 0 : }
704 : :
705 : : /* Immediate error (i.e. do not buffer). */
706 : :
707 : : void
708 : 432 : gfc_error_now (const char *gmsgid, ...)
709 : : {
710 : 432 : va_list argp;
711 : 432 : diagnostics::diagnostic_info diagnostic;
712 : 432 : rich_location rich_loc (line_table, UNKNOWN_LOCATION);
713 : :
714 : 432 : error_buffer->flag = true;
715 : :
716 : 432 : va_start (argp, gmsgid);
717 : 432 : diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc,
718 : : diagnostics::kind::error);
719 : 432 : gfc_report_diagnostic (&diagnostic);
720 : 432 : va_end (argp);
721 : 432 : }
722 : :
723 : :
724 : : /* Fatal error, never returns. */
725 : :
726 : : void
727 : 10 : gfc_fatal_error (const char *gmsgid, ...)
728 : : {
729 : 10 : va_list argp;
730 : 10 : diagnostics::diagnostic_info diagnostic;
731 : 10 : rich_location rich_loc (line_table, UNKNOWN_LOCATION);
732 : :
733 : 10 : va_start (argp, gmsgid);
734 : 10 : diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc,
735 : : diagnostics::kind::fatal);
736 : 10 : gfc_report_diagnostic (&diagnostic);
737 : 0 : va_end (argp);
738 : :
739 : 0 : gcc_unreachable ();
740 : : }
741 : :
742 : : /* Clear the warning flag. */
743 : :
744 : : void
745 : 13484780 : gfc_clear_warning (void)
746 : : {
747 : 13484780 : gfc_clear_diagnostic_buffer (pp_warning_buffer);
748 : 13484780 : }
749 : :
750 : :
751 : : /* Check to see if any warnings have been saved.
752 : : If so, print the warning. */
753 : :
754 : : void
755 : 1375409 : gfc_warning_check (void)
756 : : {
757 : 1375409 : if (! pp_warning_buffer->empty_p ())
758 : 4024 : global_dc->flush_diagnostic_buffer (*pp_warning_buffer);
759 : 1375409 : }
760 : :
761 : :
762 : : /* Issue an error. */
763 : :
764 : : static void
765 : 1199831 : gfc_error_opt (int opt, const char *gmsgid, va_list ap)
766 : : {
767 : 1199831 : va_list argp;
768 : 1199831 : va_copy (argp, ap);
769 : :
770 : 1199831 : if (warnings_not_errors)
771 : : {
772 : 44 : gfc_warning (opt, gmsgid, argp);
773 : 44 : va_end (argp);
774 : 17727 : return;
775 : : }
776 : :
777 : 1199787 : if (suppress_errors)
778 : : {
779 : 17683 : va_end (argp);
780 : 17683 : return;
781 : : }
782 : :
783 : 1182104 : diagnostics::diagnostic_info diagnostic;
784 : 1182104 : rich_location richloc (line_table, UNKNOWN_LOCATION);
785 : 1182104 : diagnostics::buffer *old_buffer = global_dc->get_diagnostic_buffer ();
786 : 1182104 : gcc_assert (!old_buffer);
787 : :
788 : 1182104 : gfc_clear_diagnostic_buffer (pp_error_buffer);
789 : :
790 : 1182104 : if (buffered_p)
791 : 1175034 : global_dc->set_diagnostic_buffer (pp_error_buffer);
792 : :
793 : 1182104 : diagnostic_set_info (&diagnostic, gmsgid, &argp, &richloc,
794 : : diagnostics::kind::error);
795 : 1182104 : gfc_report_diagnostic (&diagnostic);
796 : :
797 : 1182104 : if (buffered_p)
798 : 1175034 : global_dc->set_diagnostic_buffer (old_buffer);
799 : :
800 : 1182104 : va_end (argp);
801 : 1182104 : }
802 : :
803 : :
804 : : void
805 : 251 : gfc_error_opt (int opt, const char *gmsgid, ...)
806 : : {
807 : 251 : va_list argp;
808 : 251 : va_start (argp, gmsgid);
809 : 251 : gfc_error_opt (opt, gmsgid, argp);
810 : 251 : va_end (argp);
811 : 251 : }
812 : :
813 : :
814 : : void
815 : 1198840 : gfc_error (const char *gmsgid, ...)
816 : : {
817 : 1198840 : va_list argp;
818 : 1198840 : va_start (argp, gmsgid);
819 : 1198840 : gfc_error_opt (0, gmsgid, argp);
820 : 1198840 : va_end (argp);
821 : 1198840 : }
822 : :
823 : :
824 : : /* This shouldn't happen... but sometimes does. */
825 : :
826 : : void
827 : 0 : gfc_internal_error (const char *gmsgid, ...)
828 : : {
829 : 0 : int e, w;
830 : 0 : va_list argp;
831 : 0 : diagnostics::diagnostic_info diagnostic;
832 : 0 : rich_location rich_loc (line_table, UNKNOWN_LOCATION);
833 : :
834 : 0 : gfc_get_errors (&w, &e);
835 : 0 : if (e > 0)
836 : 0 : exit(EXIT_FAILURE);
837 : :
838 : 0 : va_start (argp, gmsgid);
839 : 0 : diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc,
840 : : diagnostics::kind::ice);
841 : 0 : gfc_report_diagnostic (&diagnostic);
842 : 0 : va_end (argp);
843 : :
844 : 0 : gcc_unreachable ();
845 : : }
846 : :
847 : :
848 : : /* Clear the error flag when we start to compile a source line. */
849 : :
850 : : void
851 : 4976620 : gfc_clear_error (void)
852 : : {
853 : 4976620 : error_buffer->flag = false;
854 : 4976620 : warnings_not_errors = false;
855 : 4976620 : gfc_clear_diagnostic_buffer (pp_error_buffer);
856 : 4976620 : }
857 : :
858 : :
859 : : /* Tests the state of error_flag. */
860 : :
861 : : bool
862 : 1623884 : gfc_error_flag_test (void)
863 : : {
864 : 1623884 : return (error_buffer->flag
865 : 1623884 : || !pp_error_buffer->empty_p ());
866 : : }
867 : :
868 : :
869 : : /* Check to see if any errors have been saved.
870 : : If so, print the error. Returns the state of error_flag. */
871 : :
872 : : bool
873 : 5419 : gfc_error_check (void)
874 : : {
875 : 5419 : if (error_buffer->flag
876 : 5419 : || ! pp_error_buffer->empty_p ())
877 : : {
878 : 3173 : error_buffer->flag = false;
879 : 3173 : global_dc->flush_diagnostic_buffer (*pp_error_buffer);
880 : 3173 : return true;
881 : : }
882 : :
883 : : return false;
884 : : }
885 : :
886 : : /* Move the text buffered from FROM to TO, then clear
887 : : FROM. Independently if there was text in FROM, TO is also
888 : : cleared. */
889 : :
890 : : static void
891 : 2988317 : gfc_move_error_buffer_from_to (gfc_error_buffer * buffer_from,
892 : : gfc_error_buffer * buffer_to)
893 : : {
894 : 2988317 : diagnostics::buffer * from = &(buffer_from->buffer);
895 : 2988317 : diagnostics::buffer * to = &(buffer_to->buffer);
896 : :
897 : 2988317 : buffer_to->flag = buffer_from->flag;
898 : 2988317 : buffer_from->flag = false;
899 : :
900 : 2988317 : gfc_clear_diagnostic_buffer (to);
901 : :
902 : 2988317 : if (! from->empty_p ())
903 : : {
904 : 103239 : from->move_to (*to);
905 : 103239 : gfc_clear_diagnostic_buffer (from);
906 : : }
907 : 2988317 : }
908 : :
909 : : /* Save the existing error state. */
910 : :
911 : : void
912 : 1531333 : gfc_push_error (gfc_error_buffer *err)
913 : : {
914 : 1531333 : gfc_move_error_buffer_from_to (error_buffer, err);
915 : 1531333 : }
916 : :
917 : :
918 : : /* Restore a previous pushed error state. */
919 : :
920 : : void
921 : 1456984 : gfc_pop_error (gfc_error_buffer *err)
922 : : {
923 : 1456984 : gfc_move_error_buffer_from_to (err, error_buffer);
924 : 1456984 : }
925 : :
926 : :
927 : : /* Free a pushed error state, but keep the current error state. */
928 : :
929 : : void
930 : 74161 : gfc_free_error (gfc_error_buffer *err)
931 : : {
932 : 74161 : gfc_clear_diagnostic_buffer (&(err->buffer));
933 : 74161 : }
934 : :
935 : :
936 : : /* Report the number of warnings and errors that occurred to the caller. */
937 : :
938 : : void
939 : 353290 : gfc_get_errors (int *w, int *e)
940 : : {
941 : 353290 : if (w != NULL)
942 : 303181 : *w = warningcount + werrorcount;
943 : 353290 : if (e != NULL)
944 : 353290 : *e = errorcount + sorrycount + werrorcount;
945 : 353290 : }
946 : :
947 : :
948 : : /* Switch errors into warnings. */
949 : :
950 : : void
951 : 48827 : gfc_errors_to_warnings (bool f)
952 : : {
953 : 48827 : warnings_not_errors = f;
954 : 48827 : }
955 : :
956 : : void
957 : 30820 : gfc_diagnostics_init (void)
958 : : {
959 : 30820 : diagnostics::text_starter (global_dc) = gfc_diagnostic_text_starter;
960 : 30820 : diagnostics::start_span (global_dc) = gfc_diagnostic_start_span;
961 : 30820 : diagnostics::text_finalizer (global_dc) = gfc_diagnostic_text_finalizer;
962 : 30820 : global_dc->set_format_decoder (gfc_format_decoder);
963 : 30820 : auto &source_printing_opts = global_dc->get_source_printing_options ();
964 : 30820 : source_printing_opts.caret_chars[0] = '1';
965 : 30820 : source_printing_opts.caret_chars[1] = '2';
966 : 30820 : pp_warning_buffer = new diagnostics::buffer (*global_dc);
967 : 30820 : error_buffer = new gfc_error_buffer ();
968 : 30820 : pp_error_buffer = &(error_buffer->buffer);
969 : 30820 : }
970 : :
971 : : void
972 : 30765 : gfc_diagnostics_finish (void)
973 : : {
974 : 30765 : tree_diagnostics_defaults (global_dc);
975 : : /* We still want to use the gfc starter and finalizer, not the tree
976 : : defaults. */
977 : 30765 : diagnostics::text_starter (global_dc) = gfc_diagnostic_text_starter;
978 : 30765 : diagnostics::text_finalizer (global_dc) = gfc_diagnostic_text_finalizer;
979 : 30765 : auto &source_printing_opts = global_dc->get_source_printing_options ();
980 : 30765 : source_printing_opts.caret_chars[0] = '^';
981 : 30765 : source_printing_opts.caret_chars[1] = '^';
982 : 61530 : delete error_buffer;
983 : 30765 : error_buffer = nullptr;
984 : 30765 : pp_error_buffer = nullptr;
985 : 30765 : }
|
