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