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