]>
Commit | Line | Data |
---|---|---|
6de9cd9a | 1 | /* Handle errors. |
99dee823 | 2 | Copyright (C) 2000-2021 Free Software Foundation, Inc. |
6de9cd9a DN |
3 | Contributed by Andy Vaught & Niels Kristian Bech Jensen |
4 | ||
9fc4d79b | 5 | This file is part of GCC. |
6de9cd9a | 6 | |
9fc4d79b TS |
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 | |
d234d788 | 9 | Software Foundation; either version 3, or (at your option) any later |
9fc4d79b | 10 | version. |
6de9cd9a | 11 | |
9fc4d79b TS |
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. | |
6de9cd9a DN |
16 | |
17 | You should have received a copy of the GNU General Public License | |
d234d788 NC |
18 | along with GCC; see the file COPYING3. If not see |
19 | <http://www.gnu.org/licenses/>. */ | |
6de9cd9a DN |
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" | |
953bee7c | 29 | #include "coretypes.h" |
1916bcb5 | 30 | #include "options.h" |
6de9cd9a DN |
31 | #include "gfortran.h" |
32 | ||
8e54f6d3 MLI |
33 | #include "diagnostic.h" |
34 | #include "diagnostic-color.h" | |
3aa34c1d | 35 | #include "tree-diagnostic.h" /* tree_diagnostics_defaults */ |
c68a6e08 | 36 | |
a3d3c0f5 | 37 | static int suppress_errors = 0; |
6de9cd9a | 38 | |
f4031599 | 39 | static bool warnings_not_errors = false; |
3af8d8cb | 40 | |
fea70c99 | 41 | static int terminal_width; |
6de9cd9a | 42 | |
0f447a6e TB |
43 | /* True if the error/warnings should be buffered. */ |
44 | static bool buffered_p; | |
fea70c99 MLI |
45 | |
46 | static gfc_error_buffer error_buffer; | |
0f447a6e TB |
47 | /* These are always buffered buffers (.flush_p == false) to be used by |
48 | the pretty-printer. */ | |
c4100eae | 49 | static output_buffer *pp_error_buffer, *pp_warning_buffer; |
48749dbc MLI |
50 | static int warningcount_buffered, werrorcount_buffered; |
51 | ||
c4100eae MLI |
52 | /* Return true if there output_buffer is empty. */ |
53 | ||
54 | static bool | |
55 | gfc_output_buffer_empty_p (const output_buffer * buf) | |
56 | { | |
57 | return output_buffer_last_position_in_text (buf) == NULL; | |
58 | } | |
6de9cd9a | 59 | |
a3d3c0f5 DK |
60 | /* Go one level deeper suppressing errors. */ |
61 | ||
62 | void | |
63 | gfc_push_suppress_errors (void) | |
64 | { | |
65 | gcc_assert (suppress_errors >= 0); | |
66 | ++suppress_errors; | |
67 | } | |
68 | ||
a4d9b221 | 69 | static void |
2700d0e3 | 70 | gfc_error_opt (int opt, const char *gmsgid, va_list ap) ATTRIBUTE_GCC_GFC(2,0); |
a4d9b221 TB |
71 | |
72 | static bool | |
73 | gfc_warning (int opt, const char *gmsgid, va_list ap) ATTRIBUTE_GCC_GFC(2,0); | |
74 | ||
a3d3c0f5 DK |
75 | |
76 | /* Leave one level of error suppressing. */ | |
77 | ||
78 | void | |
79 | gfc_pop_suppress_errors (void) | |
80 | { | |
81 | gcc_assert (suppress_errors > 0); | |
82 | --suppress_errors; | |
83 | } | |
84 | ||
85 | ||
c68a6e08 JW |
86 | /* Determine terminal width (for trimming source lines in output). */ |
87 | ||
e7333b69 | 88 | static int |
c9db45aa | 89 | gfc_get_terminal_width (void) |
e7333b69 | 90 | { |
c9db45aa | 91 | return isatty (STDERR_FILENO) ? get_terminal_width () : INT_MAX; |
e7333b69 JW |
92 | } |
93 | ||
94 | ||
6de9cd9a DN |
95 | /* Per-file error initialization. */ |
96 | ||
97 | void | |
98 | gfc_error_init_1 (void) | |
99 | { | |
c9db45aa | 100 | terminal_width = gfc_get_terminal_width (); |
0f447a6e | 101 | gfc_buffer_error (false); |
6de9cd9a DN |
102 | } |
103 | ||
104 | ||
105 | /* Set the flag for buffering errors or not. */ | |
106 | ||
107 | void | |
0f447a6e | 108 | gfc_buffer_error (bool flag) |
6de9cd9a | 109 | { |
0f447a6e | 110 | buffered_p = flag; |
6de9cd9a DN |
111 | } |
112 | ||
113 | ||
114 | /* Add a single character to the error buffer or output depending on | |
0f447a6e | 115 | buffered_p. */ |
6de9cd9a DN |
116 | |
117 | static void | |
fea70c99 | 118 | error_char (char) |
6de9cd9a | 119 | { |
fea70c99 | 120 | /* FIXME: Unused function to be removed in a subsequent patch. */ |
6de9cd9a DN |
121 | } |
122 | ||
123 | ||
124 | /* Copy a string to wherever it needs to go. */ | |
125 | ||
126 | static void | |
127 | error_string (const char *p) | |
128 | { | |
6de9cd9a DN |
129 | while (*p) |
130 | error_char (*p++); | |
131 | } | |
132 | ||
133 | ||
12c78966 BM |
134 | /* Print a formatted integer to the error buffer or output. */ |
135 | ||
096f0d9d | 136 | #define IBUF_LEN 60 |
12c78966 BM |
137 | |
138 | static void | |
096f0d9d | 139 | error_uinteger (unsigned long int i) |
12c78966 BM |
140 | { |
141 | char *p, int_buf[IBUF_LEN]; | |
142 | ||
12c78966 BM |
143 | p = int_buf + IBUF_LEN - 1; |
144 | *p-- = '\0'; | |
145 | ||
146 | if (i == 0) | |
147 | *p-- = '0'; | |
148 | ||
149 | while (i > 0) | |
150 | { | |
151 | *p-- = i % 10 + '0'; | |
152 | i = i / 10; | |
153 | } | |
154 | ||
155 | error_string (p + 1); | |
156 | } | |
157 | ||
096f0d9d FXC |
158 | static void |
159 | error_integer (long int i) | |
160 | { | |
161 | unsigned long int u; | |
162 | ||
163 | if (i < 0) | |
164 | { | |
165 | u = (unsigned long int) -i; | |
166 | error_char ('-'); | |
167 | } | |
168 | else | |
169 | u = i; | |
170 | ||
171 | error_uinteger (u); | |
172 | } | |
173 | ||
12c78966 | 174 | |
a5d6c754 FXC |
175 | static size_t |
176 | gfc_widechar_display_length (gfc_char_t c) | |
177 | { | |
a1b60e49 FXC |
178 | if (gfc_wide_is_printable (c) || c == '\t') |
179 | /* Printable ASCII character, or tabulation (output as a space). */ | |
a5d6c754 FXC |
180 | return 1; |
181 | else if (c < ((gfc_char_t) 1 << 8)) | |
182 | /* Displayed as \x?? */ | |
183 | return 4; | |
184 | else if (c < ((gfc_char_t) 1 << 16)) | |
185 | /* Displayed as \u???? */ | |
186 | return 6; | |
187 | else | |
188 | /* Displayed as \U???????? */ | |
189 | return 10; | |
190 | } | |
191 | ||
192 | ||
193 | /* Length of the ASCII representation of the wide string, escaping wide | |
194 | characters as print_wide_char_into_buffer() does. */ | |
195 | ||
196 | static size_t | |
197 | gfc_wide_display_length (const gfc_char_t *str) | |
198 | { | |
199 | size_t i, len; | |
200 | ||
201 | for (i = 0, len = 0; str[i]; i++) | |
202 | len += gfc_widechar_display_length (str[i]); | |
203 | ||
204 | return len; | |
205 | } | |
206 | ||
207 | static int | |
d393bbd7 | 208 | print_wide_char_into_buffer (gfc_char_t c, char *buf) |
8fc541d3 FXC |
209 | { |
210 | static const char xdigit[16] = { '0', '1', '2', '3', '4', '5', '6', | |
211 | '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F' }; | |
8fc541d3 | 212 | |
a1b60e49 | 213 | if (gfc_wide_is_printable (c) || c == '\t') |
00660189 FXC |
214 | { |
215 | buf[1] = '\0'; | |
a1b60e49 FXC |
216 | /* Tabulation is output as a space. */ |
217 | buf[0] = (unsigned char) (c == '\t' ? ' ' : c); | |
a5d6c754 | 218 | return 1; |
00660189 | 219 | } |
8fc541d3 FXC |
220 | else if (c < ((gfc_char_t) 1 << 8)) |
221 | { | |
00660189 FXC |
222 | buf[4] = '\0'; |
223 | buf[3] = xdigit[c & 0x0F]; | |
8fc541d3 | 224 | c = c >> 4; |
00660189 | 225 | buf[2] = xdigit[c & 0x0F]; |
8fc541d3 | 226 | |
d393bbd7 FXC |
227 | buf[1] = 'x'; |
228 | buf[0] = '\\'; | |
a5d6c754 | 229 | return 4; |
8fc541d3 FXC |
230 | } |
231 | else if (c < ((gfc_char_t) 1 << 16)) | |
232 | { | |
00660189 FXC |
233 | buf[6] = '\0'; |
234 | buf[5] = xdigit[c & 0x0F]; | |
8fc541d3 | 235 | c = c >> 4; |
00660189 | 236 | buf[4] = xdigit[c & 0x0F]; |
8fc541d3 | 237 | c = c >> 4; |
00660189 | 238 | buf[3] = xdigit[c & 0x0F]; |
8fc541d3 | 239 | c = c >> 4; |
00660189 | 240 | buf[2] = xdigit[c & 0x0F]; |
8fc541d3 | 241 | |
d393bbd7 FXC |
242 | buf[1] = 'u'; |
243 | buf[0] = '\\'; | |
a5d6c754 | 244 | return 6; |
8fc541d3 FXC |
245 | } |
246 | else | |
247 | { | |
00660189 FXC |
248 | buf[10] = '\0'; |
249 | buf[9] = xdigit[c & 0x0F]; | |
250 | c = c >> 4; | |
251 | buf[8] = xdigit[c & 0x0F]; | |
252 | c = c >> 4; | |
8fc541d3 FXC |
253 | buf[7] = xdigit[c & 0x0F]; |
254 | c = c >> 4; | |
255 | buf[6] = xdigit[c & 0x0F]; | |
256 | c = c >> 4; | |
257 | buf[5] = xdigit[c & 0x0F]; | |
258 | c = c >> 4; | |
259 | buf[4] = xdigit[c & 0x0F]; | |
260 | c = c >> 4; | |
261 | buf[3] = xdigit[c & 0x0F]; | |
262 | c = c >> 4; | |
263 | buf[2] = xdigit[c & 0x0F]; | |
8fc541d3 | 264 | |
d393bbd7 FXC |
265 | buf[1] = 'U'; |
266 | buf[0] = '\\'; | |
a5d6c754 | 267 | return 10; |
8fc541d3 | 268 | } |
d393bbd7 | 269 | } |
00660189 | 270 | |
d393bbd7 FXC |
271 | static char wide_char_print_buffer[11]; |
272 | ||
273 | const char * | |
274 | gfc_print_wide_char (gfc_char_t c) | |
275 | { | |
276 | print_wide_char_into_buffer (c, wide_char_print_buffer); | |
277 | return wide_char_print_buffer; | |
8fc541d3 FXC |
278 | } |
279 | ||
d393bbd7 | 280 | |
00660189 FXC |
281 | /* Show the file, where it was included, and the source line, give a |
282 | locus. Calls error_printf() recursively, but the recursion is at | |
283 | most one level deep. */ | |
284 | ||
0ce0154c | 285 | static void error_printf (const char *, ...) ATTRIBUTE_GCC_GFC(1,2); |
6de9cd9a DN |
286 | |
287 | static void | |
636dff67 | 288 | show_locus (locus *loc, int c1, int c2) |
6de9cd9a | 289 | { |
d4fa05b9 | 290 | gfc_linebuf *lb; |
6de9cd9a | 291 | gfc_file *f; |
a1b60e49 | 292 | gfc_char_t *p; |
8fc541d3 | 293 | int i, offset, cmax; |
6de9cd9a DN |
294 | |
295 | /* TODO: Either limit the total length and number of included files | |
296 | displayed or add buffering of arbitrary number of characters in | |
297 | error messages. */ | |
6de9cd9a | 298 | |
12c78966 BM |
299 | /* Write out the error header line, giving the source file and error |
300 | location (in GNU standard "[file]:[line].[column]:" format), | |
301 | followed by an "included by" stack and a blank line. This header | |
302 | format is matched by a testsuite parser defined in | |
303 | lib/gfortran-dg.exp. */ | |
304 | ||
d4fa05b9 TS |
305 | lb = loc->lb; |
306 | f = lb->file; | |
12c78966 BM |
307 | |
308 | error_string (f->filename); | |
309 | error_char (':'); | |
a23404c9 | 310 | |
12c78966 | 311 | error_integer (LOCATION_LINE (lb->location)); |
12c78966 BM |
312 | |
313 | if ((c1 > 0) || (c2 > 0)) | |
314 | error_char ('.'); | |
315 | ||
316 | if (c1 > 0) | |
317 | error_integer (c1); | |
318 | ||
319 | if ((c1 > 0) && (c2 > 0)) | |
320 | error_char ('-'); | |
321 | ||
322 | if (c2 > 0) | |
323 | error_integer (c2); | |
324 | ||
325 | error_char (':'); | |
326 | error_char ('\n'); | |
d4fa05b9 TS |
327 | |
328 | for (;;) | |
6de9cd9a | 329 | { |
d4fa05b9 TS |
330 | i = f->inclusion_line; |
331 | ||
60332588 | 332 | f = f->up; |
d4fa05b9 TS |
333 | if (f == NULL) break; |
334 | ||
12c78966 | 335 | error_printf (" Included at %s:%d:", f->filename, i); |
6de9cd9a DN |
336 | } |
337 | ||
12c78966 BM |
338 | error_char ('\n'); |
339 | ||
340 | /* Calculate an appropriate horizontal offset of the source line in | |
341 | order to get the error locus within the visible portion of the | |
342 | line. Note that if the margin of 5 here is changed, the | |
343 | corresponding margin of 10 in show_loci should be changed. */ | |
344 | ||
345 | offset = 0; | |
346 | ||
12c78966 BM |
347 | /* If the two loci would appear in the same column, we shift |
348 | '2' one column to the right, so as to print '12' rather than | |
349 | just '1'. We do this here so it will be accounted for in the | |
350 | margin calculations. */ | |
351 | ||
352 | if (c1 == c2) | |
353 | c2 += 1; | |
354 | ||
355 | cmax = (c1 < c2) ? c2 : c1; | |
356 | if (cmax > terminal_width - 5) | |
357 | offset = cmax - terminal_width + 5; | |
358 | ||
6de9cd9a | 359 | /* Show the line itself, taking care not to print more than what can |
a23404c9 | 360 | show up on the terminal. Tabs are converted to spaces, and |
12c78966 BM |
361 | nonprintable characters are converted to a "\xNN" sequence. */ |
362 | ||
8fc541d3 | 363 | p = &(lb->line[offset]); |
a5d6c754 | 364 | i = gfc_wide_display_length (p); |
6de9cd9a DN |
365 | if (i > terminal_width) |
366 | i = terminal_width - 1; | |
367 | ||
a5d6c754 | 368 | while (i > 0) |
6de9cd9a | 369 | { |
d393bbd7 | 370 | static char buffer[11]; |
a1b60e49 | 371 | i -= print_wide_char_into_buffer (*p++, buffer); |
d393bbd7 | 372 | error_string (buffer); |
6de9cd9a DN |
373 | } |
374 | ||
375 | error_char ('\n'); | |
12c78966 BM |
376 | |
377 | /* Show the '1' and/or '2' corresponding to the column of the error | |
a23404c9 | 378 | locus. Note that a value of -1 for c1 or c2 will simply cause |
12c78966 BM |
379 | the relevant number not to be printed. */ |
380 | ||
381 | c1 -= offset; | |
382 | c2 -= offset; | |
a21d0595 | 383 | cmax -= offset; |
12c78966 | 384 | |
a5d6c754 | 385 | p = &(lb->line[offset]); |
021aa628 | 386 | for (i = 0; i < cmax; i++) |
12c78966 | 387 | { |
a5d6c754 FXC |
388 | int spaces, j; |
389 | spaces = gfc_widechar_display_length (*p++); | |
390 | ||
12c78966 | 391 | if (i == c1) |
a5d6c754 | 392 | error_char ('1'), spaces--; |
12c78966 | 393 | else if (i == c2) |
a5d6c754 FXC |
394 | error_char ('2'), spaces--; |
395 | ||
396 | for (j = 0; j < spaces; j++) | |
12c78966 BM |
397 | error_char (' '); |
398 | } | |
399 | ||
021aa628 TB |
400 | if (i == c1) |
401 | error_char ('1'); | |
402 | else if (i == c2) | |
403 | error_char ('2'); | |
404 | ||
12c78966 BM |
405 | error_char ('\n'); |
406 | ||
6de9cd9a DN |
407 | } |
408 | ||
409 | ||
410 | /* As part of printing an error, we show the source lines that caused | |
12c78966 BM |
411 | the problem. We show at least one, and possibly two loci; the two |
412 | loci may or may not be on the same source line. */ | |
6de9cd9a DN |
413 | |
414 | static void | |
636dff67 | 415 | show_loci (locus *l1, locus *l2) |
6de9cd9a | 416 | { |
12c78966 | 417 | int m, c1, c2; |
6de9cd9a | 418 | |
fc29d5c4 | 419 | if (l1 == NULL || l1->lb == NULL) |
6de9cd9a DN |
420 | { |
421 | error_printf ("<During initialization>\n"); | |
422 | return; | |
423 | } | |
424 | ||
12c78966 BM |
425 | /* While calculating parameters for printing the loci, we consider possible |
426 | reasons for printing one per line. If appropriate, print the loci | |
427 | individually; otherwise we print them both on the same line. */ | |
428 | ||
d4fa05b9 | 429 | c1 = l1->nextc - l1->lb->line; |
6de9cd9a | 430 | if (l2 == NULL) |
12c78966 BM |
431 | { |
432 | show_locus (l1, c1, -1); | |
433 | return; | |
434 | } | |
6de9cd9a | 435 | |
d4fa05b9 | 436 | c2 = l2->nextc - l2->lb->line; |
6de9cd9a DN |
437 | |
438 | if (c1 < c2) | |
439 | m = c2 - c1; | |
440 | else | |
441 | m = c1 - c2; | |
442 | ||
a23404c9 | 443 | /* Note that the margin value of 10 here needs to be less than the |
12c78966 | 444 | margin of 5 used in the calculation of offset in show_locus. */ |
6de9cd9a | 445 | |
d4fa05b9 | 446 | if (l1->lb != l2->lb || m > terminal_width - 10) |
6de9cd9a | 447 | { |
12c78966 BM |
448 | show_locus (l1, c1, -1); |
449 | show_locus (l2, -1, c2); | |
450 | return; | |
6de9cd9a DN |
451 | } |
452 | ||
12c78966 | 453 | show_locus (l1, c1, c2); |
6de9cd9a DN |
454 | |
455 | return; | |
6de9cd9a DN |
456 | } |
457 | ||
458 | ||
459 | /* Workhorse for the error printing subroutines. This subroutine is | |
460 | inspired by g77's error handling and is similar to printf() with | |
461 | the following %-codes: | |
462 | ||
12c78966 | 463 | %c Character, %d or %i Integer, %s String, %% Percent |
6de9cd9a DN |
464 | %L Takes locus argument |
465 | %C Current locus (no argument) | |
466 | ||
467 | If a locus pointer is given, the actual source line is printed out | |
468 | and the column is indicated. Since we want the error message at | |
469 | the bottom of any source file information, we must scan the | |
a23404c9 | 470 | argument list twice -- once to determine whether the loci are |
12c78966 BM |
471 | present and record this for printing, and once to print the error |
472 | message after and loci have been printed. A maximum of two locus | |
473 | arguments are permitted. | |
a23404c9 | 474 | |
12c78966 BM |
475 | This function is also called (recursively) by show_locus in the |
476 | case of included files; however, as show_locus does not resupply | |
477 | any loci, the recursion is at most one level deep. */ | |
6de9cd9a | 478 | |
6de9cd9a DN |
479 | #define MAX_ARGS 10 |
480 | ||
0ce0154c | 481 | static void ATTRIBUTE_GCC_GFC(2,0) |
6de9cd9a DN |
482 | error_print (const char *type, const char *format0, va_list argp) |
483 | { | |
096f0d9d FXC |
484 | enum { TYPE_CURRENTLOC, TYPE_LOCUS, TYPE_INTEGER, TYPE_UINTEGER, |
485 | TYPE_LONGINT, TYPE_ULONGINT, TYPE_CHAR, TYPE_STRING, | |
9406549c FXC |
486 | NOTYPE }; |
487 | struct | |
488 | { | |
489 | int type; | |
490 | int pos; | |
491 | union | |
492 | { | |
493 | int intval; | |
096f0d9d FXC |
494 | unsigned int uintval; |
495 | long int longintval; | |
496 | unsigned long int ulongintval; | |
9406549c FXC |
497 | char charval; |
498 | const char * stringval; | |
499 | } u; | |
500 | } arg[MAX_ARGS], spec[MAX_ARGS]; | |
501 | /* spec is the array of specifiers, in the same order as they | |
502 | appear in the format string. arg is the array of arguments, | |
503 | in the same order as they appear in the va_list. */ | |
504 | ||
505 | char c; | |
506 | int i, n, have_l1, pos, maxpos; | |
6de9cd9a DN |
507 | locus *l1, *l2, *loc; |
508 | const char *format; | |
509 | ||
acaed831 | 510 | loc = l1 = l2 = NULL; |
6de9cd9a DN |
511 | |
512 | have_l1 = 0; | |
9406549c FXC |
513 | pos = -1; |
514 | maxpos = -1; | |
6de9cd9a DN |
515 | |
516 | n = 0; | |
517 | format = format0; | |
518 | ||
9406549c FXC |
519 | for (i = 0; i < MAX_ARGS; i++) |
520 | { | |
521 | arg[i].type = NOTYPE; | |
522 | spec[i].pos = -1; | |
523 | } | |
524 | ||
525 | /* First parse the format string for position specifiers. */ | |
6de9cd9a DN |
526 | while (*format) |
527 | { | |
528 | c = *format++; | |
9406549c FXC |
529 | if (c != '%') |
530 | continue; | |
531 | ||
532 | if (*format == '%') | |
29ea08da TB |
533 | { |
534 | format++; | |
535 | continue; | |
536 | } | |
9406549c FXC |
537 | |
538 | if (ISDIGIT (*format)) | |
6de9cd9a | 539 | { |
9406549c FXC |
540 | /* This is a position specifier. For example, the number |
541 | 12 in the format string "%12$d", which specifies the third | |
542 | argument of the va_list, formatted in %d format. | |
543 | For details, see "man 3 printf". */ | |
544 | pos = atoi(format) - 1; | |
545 | gcc_assert (pos >= 0); | |
546 | while (ISDIGIT(*format)) | |
547 | format++; | |
c6423ef3 TB |
548 | gcc_assert (*format == '$'); |
549 | format++; | |
9406549c FXC |
550 | } |
551 | else | |
552 | pos++; | |
6de9cd9a | 553 | |
9406549c FXC |
554 | c = *format++; |
555 | ||
556 | if (pos > maxpos) | |
557 | maxpos = pos; | |
558 | ||
559 | switch (c) | |
560 | { | |
561 | case 'C': | |
562 | arg[pos].type = TYPE_CURRENTLOC; | |
563 | break; | |
564 | ||
565 | case 'L': | |
566 | arg[pos].type = TYPE_LOCUS; | |
567 | break; | |
568 | ||
569 | case 'd': | |
570 | case 'i': | |
571 | arg[pos].type = TYPE_INTEGER; | |
572 | break; | |
573 | ||
096f0d9d FXC |
574 | case 'u': |
575 | arg[pos].type = TYPE_UINTEGER; | |
13c7a7e5 | 576 | break; |
096f0d9d FXC |
577 | |
578 | case 'l': | |
579 | c = *format++; | |
580 | if (c == 'u') | |
581 | arg[pos].type = TYPE_ULONGINT; | |
582 | else if (c == 'i' || c == 'd') | |
583 | arg[pos].type = TYPE_LONGINT; | |
584 | else | |
585 | gcc_unreachable (); | |
586 | break; | |
587 | ||
9406549c FXC |
588 | case 'c': |
589 | arg[pos].type = TYPE_CHAR; | |
590 | break; | |
591 | ||
592 | case 's': | |
593 | arg[pos].type = TYPE_STRING; | |
594 | break; | |
595 | ||
596 | default: | |
597 | gcc_unreachable (); | |
598 | } | |
6de9cd9a | 599 | |
9406549c FXC |
600 | spec[n++].pos = pos; |
601 | } | |
602 | ||
603 | /* Then convert the values for each %-style argument. */ | |
604 | for (pos = 0; pos <= maxpos; pos++) | |
605 | { | |
606 | gcc_assert (arg[pos].type != NOTYPE); | |
607 | switch (arg[pos].type) | |
608 | { | |
609 | case TYPE_CURRENTLOC: | |
610 | loc = &gfc_current_locus; | |
611 | /* Fall through. */ | |
612 | ||
613 | case TYPE_LOCUS: | |
614 | if (arg[pos].type == TYPE_LOCUS) | |
6de9cd9a | 615 | loc = va_arg (argp, locus *); |
9406549c FXC |
616 | |
617 | if (have_l1) | |
618 | { | |
619 | l2 = loc; | |
620 | arg[pos].u.stringval = "(2)"; | |
981e3997 | 621 | /* Point %C first offending character not the last good one. */ |
3c917358 | 622 | if (arg[pos].type == TYPE_CURRENTLOC && *l2->nextc != '\0') |
981e3997 | 623 | l2->nextc++; |
9406549c FXC |
624 | } |
625 | else | |
626 | { | |
627 | l1 = loc; | |
628 | have_l1 = 1; | |
629 | arg[pos].u.stringval = "(1)"; | |
981e3997 | 630 | /* Point %C first offending character not the last good one. */ |
3c917358 | 631 | if (arg[pos].type == TYPE_CURRENTLOC && *l1->nextc != '\0') |
981e3997 | 632 | l1->nextc++; |
9406549c FXC |
633 | } |
634 | break; | |
635 | ||
636 | case TYPE_INTEGER: | |
637 | arg[pos].u.intval = va_arg (argp, int); | |
638 | break; | |
639 | ||
096f0d9d FXC |
640 | case TYPE_UINTEGER: |
641 | arg[pos].u.uintval = va_arg (argp, unsigned int); | |
642 | break; | |
643 | ||
644 | case TYPE_LONGINT: | |
645 | arg[pos].u.longintval = va_arg (argp, long int); | |
646 | break; | |
647 | ||
648 | case TYPE_ULONGINT: | |
649 | arg[pos].u.ulongintval = va_arg (argp, unsigned long int); | |
650 | break; | |
651 | ||
9406549c FXC |
652 | case TYPE_CHAR: |
653 | arg[pos].u.charval = (char) va_arg (argp, int); | |
654 | break; | |
655 | ||
656 | case TYPE_STRING: | |
657 | arg[pos].u.stringval = (const char *) va_arg (argp, char *); | |
658 | break; | |
659 | ||
660 | default: | |
661 | gcc_unreachable (); | |
6de9cd9a DN |
662 | } |
663 | } | |
664 | ||
9406549c FXC |
665 | for (n = 0; spec[n].pos >= 0; n++) |
666 | spec[n].u = arg[spec[n].pos].u; | |
667 | ||
6de9cd9a DN |
668 | /* Show the current loci if we have to. */ |
669 | if (have_l1) | |
670 | show_loci (l1, l2); | |
12c78966 | 671 | |
cb60c134 | 672 | if (*type) |
12c78966 BM |
673 | { |
674 | error_string (type); | |
675 | error_char (' '); | |
676 | } | |
6de9cd9a DN |
677 | |
678 | have_l1 = 0; | |
679 | format = format0; | |
680 | n = 0; | |
681 | ||
682 | for (; *format; format++) | |
683 | { | |
684 | if (*format != '%') | |
685 | { | |
686 | error_char (*format); | |
687 | continue; | |
688 | } | |
689 | ||
690 | format++; | |
636dff67 | 691 | if (ISDIGIT (*format)) |
9406549c FXC |
692 | { |
693 | /* This is a position specifier. See comment above. */ | |
636dff67 | 694 | while (ISDIGIT (*format)) |
70e7f689 | 695 | format++; |
a23404c9 | 696 | |
9406549c FXC |
697 | /* Skip over the dollar sign. */ |
698 | format++; | |
699 | } | |
a23404c9 | 700 | |
6de9cd9a DN |
701 | switch (*format) |
702 | { | |
703 | case '%': | |
704 | error_char ('%'); | |
705 | break; | |
706 | ||
707 | case 'c': | |
9406549c | 708 | error_char (spec[n++].u.charval); |
6de9cd9a DN |
709 | break; |
710 | ||
711 | case 's': | |
6de9cd9a DN |
712 | case 'C': /* Current locus */ |
713 | case 'L': /* Specified locus */ | |
9406549c | 714 | error_string (spec[n++].u.stringval); |
6de9cd9a | 715 | break; |
12c78966 | 716 | |
9406549c FXC |
717 | case 'd': |
718 | case 'i': | |
719 | error_integer (spec[n++].u.intval); | |
12c78966 | 720 | break; |
096f0d9d FXC |
721 | |
722 | case 'u': | |
723 | error_uinteger (spec[n++].u.uintval); | |
724 | break; | |
725 | ||
726 | case 'l': | |
727 | format++; | |
728 | if (*format == 'u') | |
729 | error_uinteger (spec[n++].u.ulongintval); | |
730 | else | |
731 | error_integer (spec[n++].u.longintval); | |
732 | break; | |
733 | ||
6de9cd9a DN |
734 | } |
735 | } | |
736 | ||
737 | error_char ('\n'); | |
738 | } | |
739 | ||
740 | ||
741 | /* Wrapper for error_print(). */ | |
742 | ||
743 | static void | |
d6de356a | 744 | error_printf (const char *gmsgid, ...) |
6de9cd9a DN |
745 | { |
746 | va_list argp; | |
747 | ||
d6de356a TB |
748 | va_start (argp, gmsgid); |
749 | error_print ("", _(gmsgid), argp); | |
6de9cd9a DN |
750 | va_end (argp); |
751 | } | |
752 | ||
753 | ||
48749dbc MLI |
754 | /* Clear any output buffered in a pretty-print output_buffer. */ |
755 | ||
756 | static void | |
757 | gfc_clear_pp_buffer (output_buffer *this_buffer) | |
758 | { | |
759 | pretty_printer *pp = global_dc->printer; | |
760 | output_buffer *tmp_buffer = pp->buffer; | |
761 | pp->buffer = this_buffer; | |
762 | pp_clear_output_area (pp); | |
763 | pp->buffer = tmp_buffer; | |
63019f0c MLI |
764 | /* We need to reset last_location, otherwise we may skip caret lines |
765 | when we actually give a diagnostic. */ | |
766 | global_dc->last_location = UNKNOWN_LOCATION; | |
48749dbc MLI |
767 | } |
768 | ||
736a6efc DM |
769 | /* The currently-printing diagnostic, for use by gfc_format_decoder, |
770 | for colorizing %C and %L. */ | |
771 | ||
772 | static diagnostic_info *curr_diagnostic; | |
773 | ||
774 | /* A helper function to call diagnostic_report_diagnostic, while setting | |
775 | curr_diagnostic for the duration of the call. */ | |
776 | ||
777 | static bool | |
778 | gfc_report_diagnostic (diagnostic_info *diagnostic) | |
779 | { | |
780 | gcc_assert (diagnostic != NULL); | |
781 | curr_diagnostic = diagnostic; | |
782 | bool ret = diagnostic_report_diagnostic (global_dc, diagnostic); | |
783 | curr_diagnostic = NULL; | |
784 | return ret; | |
785 | } | |
48749dbc | 786 | |
48749dbc MLI |
787 | /* This is just a helper function to avoid duplicating the logic of |
788 | gfc_warning. */ | |
789 | ||
48749dbc MLI |
790 | static bool |
791 | gfc_warning (int opt, const char *gmsgid, va_list ap) | |
792 | { | |
793 | va_list argp; | |
794 | va_copy (argp, ap); | |
795 | ||
796 | diagnostic_info diagnostic; | |
ebedc9a3 | 797 | rich_location rich_loc (line_table, UNKNOWN_LOCATION); |
48749dbc MLI |
798 | bool fatal_errors = global_dc->fatal_errors; |
799 | pretty_printer *pp = global_dc->printer; | |
800 | output_buffer *tmp_buffer = pp->buffer; | |
48749dbc | 801 | |
c4100eae | 802 | gfc_clear_pp_buffer (pp_warning_buffer); |
48749dbc MLI |
803 | |
804 | if (buffered_p) | |
805 | { | |
c4100eae | 806 | pp->buffer = pp_warning_buffer; |
48749dbc MLI |
807 | global_dc->fatal_errors = false; |
808 | /* To prevent -fmax-errors= triggering. */ | |
809 | --werrorcount; | |
810 | } | |
811 | ||
8a645150 | 812 | diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc, |
48749dbc MLI |
813 | DK_WARNING); |
814 | diagnostic.option_index = opt; | |
736a6efc | 815 | bool ret = gfc_report_diagnostic (&diagnostic); |
48749dbc MLI |
816 | |
817 | if (buffered_p) | |
818 | { | |
819 | pp->buffer = tmp_buffer; | |
820 | global_dc->fatal_errors = fatal_errors; | |
821 | ||
822 | warningcount_buffered = 0; | |
823 | werrorcount_buffered = 0; | |
824 | /* Undo the above --werrorcount if not Werror, otherwise | |
825 | werrorcount is correct already. */ | |
826 | if (!ret) | |
827 | ++werrorcount; | |
828 | else if (diagnostic.kind == DK_ERROR) | |
829 | ++werrorcount_buffered; | |
a23404c9 | 830 | else |
48749dbc MLI |
831 | ++werrorcount, --warningcount, ++warningcount_buffered; |
832 | } | |
a23404c9 | 833 | |
48749dbc MLI |
834 | va_end (argp); |
835 | return ret; | |
836 | } | |
837 | ||
838 | /* Issue a warning. */ | |
48749dbc MLI |
839 | |
840 | bool | |
841 | gfc_warning (int opt, const char *gmsgid, ...) | |
842 | { | |
843 | va_list argp; | |
844 | ||
845 | va_start (argp, gmsgid); | |
846 | bool ret = gfc_warning (opt, gmsgid, argp); | |
847 | va_end (argp); | |
848 | return ret; | |
849 | } | |
850 | ||
48749dbc | 851 | |
8f0d39a8 FXC |
852 | /* Whether, for a feature included in a given standard set (GFC_STD_*), |
853 | we should issue an error or a warning, or be quiet. */ | |
854 | ||
855 | notification | |
856 | gfc_notification_std (int std) | |
857 | { | |
858 | bool warning; | |
859 | ||
860 | warning = ((gfc_option.warn_std & std) != 0) && !inhibit_warnings; | |
861 | if ((gfc_option.allow_std & std) != 0 && !warning) | |
862 | return SILENT; | |
863 | ||
864 | return warning ? WARNING : ERROR; | |
865 | } | |
866 | ||
867 | ||
67e9518e JW |
868 | /* Return a string describing the nature of a standard violation |
869 | * and/or the relevant version of the standard. */ | |
870 | ||
871 | char const* | |
872 | notify_std_msg(int std) | |
873 | { | |
874 | ||
875 | if (std & GFC_STD_F2018_DEL) | |
876 | return _("Fortran 2018 deleted feature:"); | |
877 | else if (std & GFC_STD_F2018_OBS) | |
878 | return _("Fortran 2018 obsolescent feature:"); | |
879 | else if (std & GFC_STD_F2018) | |
880 | return _("Fortran 2018:"); | |
67e9518e JW |
881 | else if (std & GFC_STD_F2008_OBS) |
882 | return _("Fortran 2008 obsolescent feature:"); | |
883 | else if (std & GFC_STD_F2008) | |
884 | return "Fortran 2008:"; | |
885 | else if (std & GFC_STD_F2003) | |
886 | return "Fortran 2003:"; | |
887 | else if (std & GFC_STD_GNU) | |
888 | return _("GNU Extension:"); | |
889 | else if (std & GFC_STD_LEGACY) | |
890 | return _("Legacy Extension:"); | |
891 | else if (std & GFC_STD_F95_OBS) | |
892 | return _("Obsolescent feature:"); | |
893 | else if (std & GFC_STD_F95_DEL) | |
894 | return _("Deleted feature:"); | |
895 | else | |
896 | gcc_unreachable (); | |
897 | } | |
898 | ||
899 | ||
6de9cd9a DN |
900 | /* Possibly issue a warning/error about use of a nonstandard (or deleted) |
901 | feature. An error/warning will be issued if the currently selected | |
524af0d6 | 902 | standard does not contain the requested bits. Return false if |
e88763d1 | 903 | an error is generated. */ |
6de9cd9a | 904 | |
a4d9b221 TB |
905 | bool |
906 | gfc_notify_std (int std, const char *gmsgid, ...) | |
907 | { | |
908 | va_list argp; | |
a4d9b221 TB |
909 | const char *msg, *msg2; |
910 | char *buffer; | |
911 | ||
67e9518e JW |
912 | /* Determine whether an error or a warning is needed. */ |
913 | const int wstd = std & gfc_option.warn_std; /* Standard to warn about. */ | |
914 | const int estd = std & ~gfc_option.allow_std; /* Standard to error about. */ | |
915 | const bool warning = (wstd != 0) && !inhibit_warnings; | |
916 | const bool error = (estd != 0); | |
a4d9b221 | 917 | |
67e9518e JW |
918 | if (!error && !warning) |
919 | return true; | |
a4d9b221 | 920 | if (suppress_errors) |
67e9518e | 921 | return !error; |
a4d9b221 | 922 | |
67e9518e JW |
923 | if (error) |
924 | msg = notify_std_msg (estd); | |
925 | else | |
926 | msg = notify_std_msg (wstd); | |
a4d9b221 TB |
927 | |
928 | msg2 = _(gmsgid); | |
929 | buffer = (char *) alloca (strlen (msg) + strlen (msg2) + 2); | |
930 | strcpy (buffer, msg); | |
931 | strcat (buffer, " "); | |
932 | strcat (buffer, msg2); | |
933 | ||
934 | va_start (argp, gmsgid); | |
67e9518e | 935 | if (error) |
2700d0e3 | 936 | gfc_error_opt (0, buffer, argp); |
67e9518e JW |
937 | else |
938 | gfc_warning (0, buffer, argp); | |
a4d9b221 TB |
939 | va_end (argp); |
940 | ||
67e9518e JW |
941 | if (error) |
942 | return false; | |
943 | else | |
944 | return (warning && !warnings_are_errors); | |
a4d9b221 TB |
945 | } |
946 | ||
947 | ||
3aa34c1d MLI |
948 | /* Called from output_format -- during diagnostic message processing |
949 | to handle Fortran specific format specifiers with the following meanings: | |
950 | ||
951 | %C Current locus (no argument) | |
a96c39ea | 952 | %L Takes locus argument |
3aa34c1d MLI |
953 | */ |
954 | static bool | |
c05c2380 | 955 | gfc_format_decoder (pretty_printer *pp, text_info *text, const char *spec, |
f012c8ef | 956 | int precision, bool wide, bool set_locus, bool hash, |
ce95abc4 | 957 | bool *quoted, const char **buffer_ptr) |
3aa34c1d MLI |
958 | { |
959 | switch (*spec) | |
960 | { | |
961 | case 'C': | |
a96c39ea | 962 | case 'L': |
3aa34c1d | 963 | { |
2a2703a2 | 964 | static const char *result[2] = { "(1)", "(2)" }; |
a96c39ea MLI |
965 | locus *loc; |
966 | if (*spec == 'C') | |
967 | loc = &gfc_current_locus; | |
968 | else | |
969 | loc = va_arg (*text->args_ptr, locus *); | |
970 | gcc_assert (loc->nextc - loc->lb->line >= 0); | |
971 | unsigned int offset = loc->nextc - loc->lb->line; | |
3c917358 | 972 | if (*spec == 'C' && *loc->nextc != '\0') |
981e3997 TB |
973 | /* Point %C first offending character not the last good one. */ |
974 | offset++; | |
2a2703a2 MLI |
975 | /* If location[0] != UNKNOWN_LOCATION means that we already |
976 | processed one of %C/%L. */ | |
977 | int loc_num = text->get_location (0) == UNKNOWN_LOCATION ? 0 : 1; | |
f79520bb DM |
978 | location_t src_loc |
979 | = linemap_position_for_loc_and_offset (line_table, | |
980 | loc->lb->location, | |
981 | offset); | |
85204e23 | 982 | text->set_location (loc_num, src_loc, SHOW_RANGE_WITH_CARET); |
736a6efc DM |
983 | /* Colorize the markers to match the color choices of |
984 | diagnostic_show_locus (the initial location has a color given | |
985 | by the "kind" of the diagnostic, the secondary location has | |
986 | color "range1"). */ | |
987 | gcc_assert (curr_diagnostic != NULL); | |
988 | const char *color | |
989 | = (loc_num | |
990 | ? "range1" | |
991 | : diagnostic_get_color_for_kind (curr_diagnostic->kind)); | |
992 | pp_string (pp, colorize_start (pp_show_color (pp), color)); | |
2a2703a2 | 993 | pp_string (pp, result[loc_num]); |
736a6efc | 994 | pp_string (pp, colorize_stop (pp_show_color (pp))); |
3aa34c1d MLI |
995 | return true; |
996 | } | |
997 | default: | |
c05c2380 JJ |
998 | /* Fall through info the middle-end decoder, as e.g. stor-layout.c |
999 | etc. diagnostics can use the FE printer while the FE is still | |
1000 | active. */ | |
1001 | return default_tree_printer (pp, text, spec, precision, wide, | |
f012c8ef | 1002 | set_locus, hash, quoted, buffer_ptr); |
3aa34c1d MLI |
1003 | } |
1004 | } | |
1005 | ||
2a2703a2 MLI |
1006 | /* Return a malloc'd string describing the kind of diagnostic. The |
1007 | caller is responsible for freeing the memory. */ | |
8e54f6d3 | 1008 | static char * |
2a2703a2 MLI |
1009 | gfc_diagnostic_build_kind_prefix (diagnostic_context *context, |
1010 | const diagnostic_info *diagnostic) | |
8e54f6d3 MLI |
1011 | { |
1012 | static const char *const diagnostic_kind_text[] = { | |
1013 | #define DEFINE_DIAGNOSTIC_KIND(K, T, C) (T), | |
1014 | #include "gfc-diagnostic.def" | |
1015 | #undef DEFINE_DIAGNOSTIC_KIND | |
1016 | "must-not-happen" | |
1017 | }; | |
1018 | static const char *const diagnostic_kind_color[] = { | |
1019 | #define DEFINE_DIAGNOSTIC_KIND(K, T, C) (C), | |
1020 | #include "gfc-diagnostic.def" | |
1021 | #undef DEFINE_DIAGNOSTIC_KIND | |
1022 | NULL | |
1023 | }; | |
1024 | gcc_assert (diagnostic->kind < DK_LAST_DIAGNOSTIC_KIND); | |
1025 | const char *text = _(diagnostic_kind_text[diagnostic->kind]); | |
1026 | const char *text_cs = "", *text_ce = ""; | |
1027 | pretty_printer *pp = context->printer; | |
1028 | ||
1029 | if (diagnostic_kind_color[diagnostic->kind]) | |
1030 | { | |
1031 | text_cs = colorize_start (pp_show_color (pp), | |
1032 | diagnostic_kind_color[diagnostic->kind]); | |
1033 | text_ce = colorize_stop (pp_show_color (pp)); | |
1034 | } | |
bc1b9ef1 | 1035 | return build_message_string ("%s%s:%s ", text_cs, text, text_ce); |
fbecdc83 MLI |
1036 | } |
1037 | ||
1038 | /* Return a malloc'd string describing a location. The caller is | |
1039 | responsible for freeing the memory. */ | |
1040 | static char * | |
1041 | gfc_diagnostic_build_locus_prefix (diagnostic_context *context, | |
2a2703a2 | 1042 | expanded_location s) |
fbecdc83 MLI |
1043 | { |
1044 | pretty_printer *pp = context->printer; | |
8e54f6d3 MLI |
1045 | const char *locus_cs = colorize_start (pp_show_color (pp), "locus"); |
1046 | const char *locus_ce = colorize_stop (pp_show_color (pp)); | |
8e54f6d3 | 1047 | return (s.file == NULL |
a56abdcc | 1048 | ? build_message_string ("%s%s:%s", locus_cs, progname, locus_ce ) |
8e54f6d3 | 1049 | : !strcmp (s.file, N_("<built-in>")) |
a56abdcc | 1050 | ? build_message_string ("%s%s:%s", locus_cs, s.file, locus_ce) |
8e54f6d3 | 1051 | : context->show_column |
a56abdcc | 1052 | ? build_message_string ("%s%s:%d:%d:%s", locus_cs, s.file, s.line, |
fbecdc83 | 1053 | s.column, locus_ce) |
a56abdcc | 1054 | : build_message_string ("%s%s:%d:%s", locus_cs, s.file, s.line, locus_ce)); |
8e54f6d3 MLI |
1055 | } |
1056 | ||
2a2703a2 MLI |
1057 | /* Return a malloc'd string describing two locations. The caller is |
1058 | responsible for freeing the memory. */ | |
1059 | static char * | |
1060 | gfc_diagnostic_build_locus_prefix (diagnostic_context *context, | |
1061 | expanded_location s, expanded_location s2) | |
1062 | { | |
1063 | pretty_printer *pp = context->printer; | |
1064 | const char *locus_cs = colorize_start (pp_show_color (pp), "locus"); | |
1065 | const char *locus_ce = colorize_stop (pp_show_color (pp)); | |
1066 | ||
1067 | return (s.file == NULL | |
1068 | ? build_message_string ("%s%s:%s", locus_cs, progname, locus_ce ) | |
1069 | : !strcmp (s.file, N_("<built-in>")) | |
1070 | ? build_message_string ("%s%s:%s", locus_cs, s.file, locus_ce) | |
1071 | : context->show_column | |
1072 | ? build_message_string ("%s%s:%d:%d-%d:%s", locus_cs, s.file, s.line, | |
1073 | MIN (s.column, s2.column), | |
1074 | MAX (s.column, s2.column), locus_ce) | |
1075 | : build_message_string ("%s%s:%d:%s", locus_cs, s.file, s.line, | |
1076 | locus_ce)); | |
1077 | } | |
1078 | ||
1079 | /* This function prints the locus (file:line:column), the diagnostic kind | |
8a645150 DM |
1080 | (Error, Warning) and (optionally) the relevant lines of code with |
1081 | annotation lines with '1' and/or '2' below them. | |
2a2703a2 | 1082 | |
8a645150 | 1083 | With -fdiagnostic-show-caret (the default) it prints: |
2a2703a2 | 1084 | |
8a645150 | 1085 | [locus of primary range]: |
a23404c9 | 1086 | |
2a2703a2 MLI |
1087 | some code |
1088 | 1 | |
1089 | Error: Some error at (1) | |
a23404c9 | 1090 | |
8a645150 DM |
1091 | With -fno-diagnostic-show-caret or if the primary range is not |
1092 | valid, it prints: | |
2a2703a2 | 1093 | |
8a645150 | 1094 | [locus of primary range]: Error: Some error at (1) and (2) |
2a2703a2 | 1095 | */ |
a23404c9 | 1096 | static void |
8e54f6d3 MLI |
1097 | gfc_diagnostic_starter (diagnostic_context *context, |
1098 | diagnostic_info *diagnostic) | |
1099 | { | |
2a2703a2 MLI |
1100 | char * kind_prefix = gfc_diagnostic_build_kind_prefix (context, diagnostic); |
1101 | ||
1102 | expanded_location s1 = diagnostic_expand_location (diagnostic); | |
1103 | expanded_location s2; | |
8a645150 | 1104 | bool one_locus = diagnostic->richloc->get_num_locations () < 2; |
2a2703a2 MLI |
1105 | bool same_locus = false; |
1106 | ||
a23404c9 | 1107 | if (!one_locus) |
2a2703a2 MLI |
1108 | { |
1109 | s2 = diagnostic_expand_location (diagnostic, 1); | |
1110 | same_locus = diagnostic_same_line (context, s1, s2); | |
1111 | } | |
1112 | ||
1113 | char * locus_prefix = (one_locus || !same_locus) | |
1114 | ? gfc_diagnostic_build_locus_prefix (context, s1) | |
1115 | : gfc_diagnostic_build_locus_prefix (context, s1, s2); | |
1116 | ||
1117 | if (!context->show_caret | |
1118 | || diagnostic_location (diagnostic, 0) <= BUILTINS_LOCATION | |
1119 | || diagnostic_location (diagnostic, 0) == context->last_location) | |
1120 | { | |
1121 | pp_set_prefix (context->printer, | |
1122 | concat (locus_prefix, " ", kind_prefix, NULL)); | |
1123 | free (locus_prefix); | |
1124 | ||
1125 | if (one_locus || same_locus) | |
1126 | { | |
1127 | free (kind_prefix); | |
1128 | return; | |
1129 | } | |
1130 | /* In this case, we print the previous locus and prefix as: | |
1131 | ||
1132 | [locus]:[prefix]: (1) | |
1133 | ||
1134 | and we flush with a new line before setting the new prefix. */ | |
1135 | pp_string (context->printer, "(1)"); | |
1136 | pp_newline (context->printer); | |
1137 | locus_prefix = gfc_diagnostic_build_locus_prefix (context, s2); | |
1138 | pp_set_prefix (context->printer, | |
1139 | concat (locus_prefix, " ", kind_prefix, NULL)); | |
1140 | free (kind_prefix); | |
1141 | free (locus_prefix); | |
1142 | } | |
1143 | else | |
fbecdc83 | 1144 | { |
51f03c6b | 1145 | pp_verbatim (context->printer, "%s", locus_prefix); |
2a2703a2 MLI |
1146 | free (locus_prefix); |
1147 | /* Fortran uses an empty line between locus and caret line. */ | |
1148 | pp_newline (context->printer); | |
e9c9a142 | 1149 | pp_set_prefix (context->printer, NULL); |
d3e28653 | 1150 | pp_newline (context->printer); |
cc015f3a | 1151 | diagnostic_show_locus (context, diagnostic->richloc, diagnostic->kind); |
fbecdc83 | 1152 | /* If the caret line was shown, the prefix does not contain the |
1cc0e193 | 1153 | locus. */ |
2a2703a2 | 1154 | pp_set_prefix (context->printer, kind_prefix); |
fbecdc83 | 1155 | } |
8e54f6d3 MLI |
1156 | } |
1157 | ||
876217ae DM |
1158 | static void |
1159 | gfc_diagnostic_start_span (diagnostic_context *context, | |
1160 | expanded_location exploc) | |
1161 | { | |
1162 | char *locus_prefix; | |
1163 | locus_prefix = gfc_diagnostic_build_locus_prefix (context, exploc); | |
51f03c6b | 1164 | pp_verbatim (context->printer, "%s", locus_prefix); |
876217ae DM |
1165 | free (locus_prefix); |
1166 | pp_newline (context->printer); | |
1167 | /* Fortran uses an empty line between locus and caret line. */ | |
1168 | pp_newline (context->printer); | |
1169 | } | |
1170 | ||
1171 | ||
8e54f6d3 | 1172 | static void |
18767f65 | 1173 | gfc_diagnostic_finalizer (diagnostic_context *context, |
478dd60d DM |
1174 | diagnostic_info *diagnostic ATTRIBUTE_UNUSED, |
1175 | diagnostic_t orig_diag_kind ATTRIBUTE_UNUSED) | |
8e54f6d3 | 1176 | { |
fbecdc83 MLI |
1177 | pp_destroy_prefix (context->printer); |
1178 | pp_newline_and_flush (context->printer); | |
8e54f6d3 MLI |
1179 | } |
1180 | ||
2a2703a2 MLI |
1181 | /* Immediate warning (i.e. do not buffer the warning) with an explicit |
1182 | location. */ | |
1183 | ||
1184 | bool | |
1185 | gfc_warning_now_at (location_t loc, int opt, const char *gmsgid, ...) | |
1186 | { | |
1187 | va_list argp; | |
1188 | diagnostic_info diagnostic; | |
ebedc9a3 | 1189 | rich_location rich_loc (line_table, loc); |
2a2703a2 MLI |
1190 | bool ret; |
1191 | ||
1192 | va_start (argp, gmsgid); | |
8a645150 | 1193 | diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc, DK_WARNING); |
2a2703a2 | 1194 | diagnostic.option_index = opt; |
736a6efc | 1195 | ret = gfc_report_diagnostic (&diagnostic); |
2a2703a2 MLI |
1196 | va_end (argp); |
1197 | return ret; | |
1198 | } | |
1199 | ||
a56abdcc | 1200 | /* Immediate warning (i.e. do not buffer the warning). */ |
8e54f6d3 | 1201 | |
7c02f68b | 1202 | bool |
4daa149b | 1203 | gfc_warning_now (int opt, const char *gmsgid, ...) |
7c02f68b MLI |
1204 | { |
1205 | va_list argp; | |
1206 | diagnostic_info diagnostic; | |
ebedc9a3 | 1207 | rich_location rich_loc (line_table, UNKNOWN_LOCATION); |
7c02f68b MLI |
1208 | bool ret; |
1209 | ||
1210 | va_start (argp, gmsgid); | |
8a645150 | 1211 | diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc, |
7c02f68b MLI |
1212 | DK_WARNING); |
1213 | diagnostic.option_index = opt; | |
736a6efc | 1214 | ret = gfc_report_diagnostic (&diagnostic); |
7c02f68b MLI |
1215 | va_end (argp); |
1216 | return ret; | |
7c02f68b MLI |
1217 | } |
1218 | ||
be841e11 TK |
1219 | /* Internal warning, do not buffer. */ |
1220 | ||
1221 | bool | |
1222 | gfc_warning_internal (int opt, const char *gmsgid, ...) | |
1223 | { | |
1224 | va_list argp; | |
1225 | diagnostic_info diagnostic; | |
1226 | rich_location rich_loc (line_table, UNKNOWN_LOCATION); | |
1227 | bool ret; | |
1228 | ||
1229 | va_start (argp, gmsgid); | |
1230 | diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc, | |
1231 | DK_WARNING); | |
1232 | diagnostic.option_index = opt; | |
736a6efc | 1233 | ret = gfc_report_diagnostic (&diagnostic); |
be841e11 TK |
1234 | va_end (argp); |
1235 | return ret; | |
1236 | } | |
7c02f68b | 1237 | |
a56abdcc | 1238 | /* Immediate error (i.e. do not buffer). */ |
7c02f68b MLI |
1239 | |
1240 | void | |
4daa149b | 1241 | gfc_error_now (const char *gmsgid, ...) |
7c02f68b MLI |
1242 | { |
1243 | va_list argp; | |
1244 | diagnostic_info diagnostic; | |
ebedc9a3 | 1245 | rich_location rich_loc (line_table, UNKNOWN_LOCATION); |
7c02f68b | 1246 | |
fea70c99 MLI |
1247 | error_buffer.flag = true; |
1248 | ||
7c02f68b | 1249 | va_start (argp, gmsgid); |
8a645150 | 1250 | diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc, DK_ERROR); |
736a6efc | 1251 | gfc_report_diagnostic (&diagnostic); |
8e54f6d3 MLI |
1252 | va_end (argp); |
1253 | } | |
6de9cd9a | 1254 | |
ddc05d11 TB |
1255 | |
1256 | /* Fatal error, never returns. */ | |
ddc05d11 TB |
1257 | |
1258 | void | |
1259 | gfc_fatal_error (const char *gmsgid, ...) | |
1260 | { | |
1261 | va_list argp; | |
1262 | diagnostic_info diagnostic; | |
ebedc9a3 | 1263 | rich_location rich_loc (line_table, UNKNOWN_LOCATION); |
ddc05d11 TB |
1264 | |
1265 | va_start (argp, gmsgid); | |
8a645150 | 1266 | diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc, DK_FATAL); |
736a6efc | 1267 | gfc_report_diagnostic (&diagnostic); |
ddc05d11 TB |
1268 | va_end (argp); |
1269 | ||
1270 | gcc_unreachable (); | |
1271 | } | |
1272 | ||
6de9cd9a DN |
1273 | /* Clear the warning flag. */ |
1274 | ||
1275 | void | |
1276 | gfc_clear_warning (void) | |
1277 | { | |
c4100eae | 1278 | gfc_clear_pp_buffer (pp_warning_buffer); |
48749dbc MLI |
1279 | warningcount_buffered = 0; |
1280 | werrorcount_buffered = 0; | |
6de9cd9a DN |
1281 | } |
1282 | ||
1283 | ||
1284 | /* Check to see if any warnings have been saved. | |
1285 | If so, print the warning. */ | |
1286 | ||
1287 | void | |
1288 | gfc_warning_check (void) | |
1289 | { | |
fea70c99 | 1290 | if (! gfc_output_buffer_empty_p (pp_warning_buffer)) |
48749dbc | 1291 | { |
c4100eae MLI |
1292 | pretty_printer *pp = global_dc->printer; |
1293 | output_buffer *tmp_buffer = pp->buffer; | |
1294 | pp->buffer = pp_warning_buffer; | |
48749dbc | 1295 | pp_really_flush (pp); |
48749dbc MLI |
1296 | warningcount += warningcount_buffered; |
1297 | werrorcount += werrorcount_buffered; | |
c4100eae | 1298 | gcc_assert (warningcount_buffered + werrorcount_buffered == 1); |
5862c189 | 1299 | pp->buffer = tmp_buffer; |
a23404c9 PT |
1300 | diagnostic_action_after_output (global_dc, |
1301 | warningcount_buffered | |
c4100eae | 1302 | ? DK_WARNING : DK_ERROR); |
d0ea9f0a | 1303 | diagnostic_check_max_errors (global_dc, true); |
48749dbc | 1304 | } |
6de9cd9a DN |
1305 | } |
1306 | ||
1307 | ||
1308 | /* Issue an error. */ | |
c4100eae | 1309 | |
a4d9b221 | 1310 | static void |
2700d0e3 | 1311 | gfc_error_opt (int opt, const char *gmsgid, va_list ap) |
c4100eae MLI |
1312 | { |
1313 | va_list argp; | |
a4d9b221 | 1314 | va_copy (argp, ap); |
2423a75a | 1315 | bool saved_abort_on_error = false; |
c4100eae MLI |
1316 | |
1317 | if (warnings_not_errors) | |
1318 | { | |
eab1ee22 | 1319 | gfc_warning (opt, gmsgid, argp); |
c4100eae MLI |
1320 | va_end (argp); |
1321 | return; | |
1322 | } | |
1323 | ||
1324 | if (suppress_errors) | |
1325 | { | |
1326 | va_end (argp); | |
1327 | return; | |
1328 | } | |
1329 | ||
1330 | diagnostic_info diagnostic; | |
ebedc9a3 | 1331 | rich_location richloc (line_table, UNKNOWN_LOCATION); |
c4100eae MLI |
1332 | bool fatal_errors = global_dc->fatal_errors; |
1333 | pretty_printer *pp = global_dc->printer; | |
1334 | output_buffer *tmp_buffer = pp->buffer; | |
1335 | ||
1336 | gfc_clear_pp_buffer (pp_error_buffer); | |
1337 | ||
1338 | if (buffered_p) | |
1339 | { | |
2423a75a JD |
1340 | /* To prevent -dH from triggering an abort on a buffered error, |
1341 | save abort_on_error and restore it below. */ | |
1342 | saved_abort_on_error = global_dc->abort_on_error; | |
1343 | global_dc->abort_on_error = false; | |
c4100eae MLI |
1344 | pp->buffer = pp_error_buffer; |
1345 | global_dc->fatal_errors = false; | |
1346 | /* To prevent -fmax-errors= triggering, we decrease it before | |
2423a75a | 1347 | report_diagnostic increases it. */ |
a4d9b221 | 1348 | --errorcount; |
c4100eae MLI |
1349 | } |
1350 | ||
8a645150 | 1351 | diagnostic_set_info (&diagnostic, gmsgid, &argp, &richloc, DK_ERROR); |
736a6efc | 1352 | gfc_report_diagnostic (&diagnostic); |
c4100eae MLI |
1353 | |
1354 | if (buffered_p) | |
1355 | { | |
1356 | pp->buffer = tmp_buffer; | |
1357 | global_dc->fatal_errors = fatal_errors; | |
2423a75a JD |
1358 | global_dc->abort_on_error = saved_abort_on_error; |
1359 | ||
c4100eae | 1360 | } |
a4d9b221 | 1361 | |
c4100eae MLI |
1362 | va_end (argp); |
1363 | } | |
1364 | ||
1365 | ||
eab1ee22 | 1366 | void |
2700d0e3 | 1367 | gfc_error_opt (int opt, const char *gmsgid, ...) |
eab1ee22 FR |
1368 | { |
1369 | va_list argp; | |
1370 | va_start (argp, gmsgid); | |
2700d0e3 | 1371 | gfc_error_opt (opt, gmsgid, argp); |
eab1ee22 FR |
1372 | va_end (argp); |
1373 | } | |
1374 | ||
1375 | ||
a4d9b221 TB |
1376 | void |
1377 | gfc_error (const char *gmsgid, ...) | |
1378 | { | |
1379 | va_list argp; | |
1380 | va_start (argp, gmsgid); | |
2700d0e3 | 1381 | gfc_error_opt (0, gmsgid, argp); |
a4d9b221 TB |
1382 | va_end (argp); |
1383 | } | |
1384 | ||
6de9cd9a | 1385 | |
6de9cd9a DN |
1386 | /* This shouldn't happen... but sometimes does. */ |
1387 | ||
1388 | void | |
17d5d49f | 1389 | gfc_internal_error (const char *gmsgid, ...) |
6de9cd9a | 1390 | { |
a23404c9 | 1391 | int e, w; |
6de9cd9a | 1392 | va_list argp; |
17d5d49f | 1393 | diagnostic_info diagnostic; |
ebedc9a3 | 1394 | rich_location rich_loc (line_table, UNKNOWN_LOCATION); |
6de9cd9a | 1395 | |
a23404c9 PT |
1396 | gfc_get_errors (&w, &e); |
1397 | if (e > 0) | |
1398 | exit(EXIT_FAILURE); | |
1399 | ||
17d5d49f | 1400 | va_start (argp, gmsgid); |
8a645150 | 1401 | diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc, DK_ICE); |
736a6efc | 1402 | gfc_report_diagnostic (&diagnostic); |
6de9cd9a DN |
1403 | va_end (argp); |
1404 | ||
17d5d49f | 1405 | gcc_unreachable (); |
6de9cd9a DN |
1406 | } |
1407 | ||
1408 | ||
1409 | /* Clear the error flag when we start to compile a source line. */ | |
1410 | ||
1411 | void | |
1412 | gfc_clear_error (void) | |
1413 | { | |
981e3997 | 1414 | error_buffer.flag = false; |
f4031599 | 1415 | warnings_not_errors = false; |
c4100eae | 1416 | gfc_clear_pp_buffer (pp_error_buffer); |
6de9cd9a DN |
1417 | } |
1418 | ||
1419 | ||
8f81c3c6 PT |
1420 | /* Tests the state of error_flag. */ |
1421 | ||
0f447a6e | 1422 | bool |
8f81c3c6 PT |
1423 | gfc_error_flag_test (void) |
1424 | { | |
a23404c9 | 1425 | return error_buffer.flag |
c4100eae | 1426 | || !gfc_output_buffer_empty_p (pp_error_buffer); |
8f81c3c6 PT |
1427 | } |
1428 | ||
1429 | ||
6de9cd9a DN |
1430 | /* Check to see if any errors have been saved. |
1431 | If so, print the error. Returns the state of error_flag. */ | |
1432 | ||
b5a9fd3e | 1433 | bool |
6de9cd9a DN |
1434 | gfc_error_check (void) |
1435 | { | |
fea70c99 MLI |
1436 | if (error_buffer.flag |
1437 | || ! gfc_output_buffer_empty_p (pp_error_buffer)) | |
c4100eae | 1438 | { |
fea70c99 | 1439 | error_buffer.flag = false; |
c4100eae MLI |
1440 | pretty_printer *pp = global_dc->printer; |
1441 | output_buffer *tmp_buffer = pp->buffer; | |
1442 | pp->buffer = pp_error_buffer; | |
1443 | pp_really_flush (pp); | |
1444 | ++errorcount; | |
1445 | gcc_assert (gfc_output_buffer_empty_p (pp_error_buffer)); | |
c4100eae | 1446 | pp->buffer = tmp_buffer; |
5862c189 | 1447 | diagnostic_action_after_output (global_dc, DK_ERROR); |
d0ea9f0a | 1448 | diagnostic_check_max_errors (global_dc, true); |
fea70c99 | 1449 | return true; |
c4100eae | 1450 | } |
6de9cd9a | 1451 | |
fea70c99 | 1452 | return false; |
6de9cd9a DN |
1453 | } |
1454 | ||
c4100eae MLI |
1455 | /* Move the text buffered from FROM to TO, then clear |
1456 | FROM. Independently if there was text in FROM, TO is also | |
1457 | cleared. */ | |
1458 | ||
1459 | static void | |
fea70c99 MLI |
1460 | gfc_move_error_buffer_from_to (gfc_error_buffer * buffer_from, |
1461 | gfc_error_buffer * buffer_to) | |
c4100eae | 1462 | { |
fea70c99 MLI |
1463 | output_buffer * from = &(buffer_from->buffer); |
1464 | output_buffer * to = &(buffer_to->buffer); | |
1465 | ||
1466 | buffer_to->flag = buffer_from->flag; | |
1467 | buffer_from->flag = false; | |
1468 | ||
c4100eae MLI |
1469 | gfc_clear_pp_buffer (to); |
1470 | /* We make sure this is always buffered. */ | |
1471 | to->flush_p = false; | |
1472 | ||
1473 | if (! gfc_output_buffer_empty_p (from)) | |
1474 | { | |
1475 | const char *str = output_buffer_formatted_text (from); | |
1476 | output_buffer_append_r (to, str, strlen (str)); | |
1477 | gfc_clear_pp_buffer (from); | |
1478 | } | |
1479 | } | |
6de9cd9a DN |
1480 | |
1481 | /* Save the existing error state. */ | |
1482 | ||
1483 | void | |
fea70c99 | 1484 | gfc_push_error (gfc_error_buffer *err) |
6de9cd9a | 1485 | { |
fea70c99 | 1486 | gfc_move_error_buffer_from_to (&error_buffer, err); |
6de9cd9a DN |
1487 | } |
1488 | ||
1489 | ||
1490 | /* Restore a previous pushed error state. */ | |
1491 | ||
1492 | void | |
fea70c99 | 1493 | gfc_pop_error (gfc_error_buffer *err) |
6de9cd9a | 1494 | { |
fea70c99 | 1495 | gfc_move_error_buffer_from_to (err, &error_buffer); |
d71b89ca JJ |
1496 | } |
1497 | ||
1498 | ||
1499 | /* Free a pushed error state, but keep the current error state. */ | |
1500 | ||
1501 | void | |
fea70c99 | 1502 | gfc_free_error (gfc_error_buffer *err) |
d71b89ca | 1503 | { |
fea70c99 | 1504 | gfc_clear_pp_buffer (&(err->buffer)); |
6de9cd9a DN |
1505 | } |
1506 | ||
1507 | ||
1f2959f0 | 1508 | /* Report the number of warnings and errors that occurred to the caller. */ |
6de9cd9a DN |
1509 | |
1510 | void | |
1511 | gfc_get_errors (int *w, int *e) | |
1512 | { | |
6de9cd9a | 1513 | if (w != NULL) |
fea70c99 | 1514 | *w = warningcount + werrorcount; |
6de9cd9a | 1515 | if (e != NULL) |
fea70c99 | 1516 | *e = errorcount + sorrycount + werrorcount; |
6de9cd9a | 1517 | } |
3af8d8cb PT |
1518 | |
1519 | ||
1520 | /* Switch errors into warnings. */ | |
1521 | ||
1522 | void | |
f4031599 | 1523 | gfc_errors_to_warnings (bool f) |
3af8d8cb | 1524 | { |
f4031599 | 1525 | warnings_not_errors = f; |
3af8d8cb | 1526 | } |
8e54f6d3 MLI |
1527 | |
1528 | void | |
1529 | gfc_diagnostics_init (void) | |
1530 | { | |
1531 | diagnostic_starter (global_dc) = gfc_diagnostic_starter; | |
876217ae | 1532 | global_dc->start_span = gfc_diagnostic_start_span; |
8e54f6d3 | 1533 | diagnostic_finalizer (global_dc) = gfc_diagnostic_finalizer; |
3aa34c1d | 1534 | diagnostic_format_decoder (global_dc) = gfc_format_decoder; |
2a2703a2 MLI |
1535 | global_dc->caret_chars[0] = '1'; |
1536 | global_dc->caret_chars[1] = '2'; | |
c4100eae MLI |
1537 | pp_warning_buffer = new (XNEW (output_buffer)) output_buffer (); |
1538 | pp_warning_buffer->flush_p = false; | |
5862c189 MLI |
1539 | /* pp_error_buffer is statically allocated. This simplifies memory |
1540 | management when using gfc_push/pop_error. */ | |
fea70c99 | 1541 | pp_error_buffer = &(error_buffer.buffer); |
c4100eae | 1542 | pp_error_buffer->flush_p = false; |
3aa34c1d MLI |
1543 | } |
1544 | ||
1545 | void | |
1546 | gfc_diagnostics_finish (void) | |
1547 | { | |
1548 | tree_diagnostics_defaults (global_dc); | |
1549 | /* We still want to use the gfc starter and finalizer, not the tree | |
1550 | defaults. */ | |
1551 | diagnostic_starter (global_dc) = gfc_diagnostic_starter; | |
1552 | diagnostic_finalizer (global_dc) = gfc_diagnostic_finalizer; | |
2a2703a2 MLI |
1553 | global_dc->caret_chars[0] = '^'; |
1554 | global_dc->caret_chars[1] = '^'; | |
8e54f6d3 | 1555 | } |