Branch data Line data Source code
1 : : /* Handle errors.
2 : : Copyright (C) 2000-2024 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 : 5317825 : 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 : 402861 : gfc_push_suppress_errors (void)
71 : : {
72 : 402861 : gcc_assert (suppress_errors >= 0);
73 : 402861 : ++suppress_errors;
74 : 402861 : }
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 : 402861 : gfc_pop_suppress_errors (void)
87 : : {
88 : 402861 : gcc_assert (suppress_errors > 0);
89 : 402861 : --suppress_errors;
90 : 402861 : }
91 : :
92 : :
93 : : /* Query whether errors are suppressed. */
94 : :
95 : : bool
96 : 138 : gfc_query_suppress_errors (void)
97 : : {
98 : 138 : return suppress_errors > 0;
99 : : }
100 : :
101 : :
102 : : /* Determine terminal width (for trimming source lines in output). */
103 : :
104 : : static int
105 : 29608 : gfc_get_terminal_width (void)
106 : : {
107 : 29608 : return isatty (STDERR_FILENO) ? get_terminal_width () : INT_MAX;
108 : : }
109 : :
110 : :
111 : : /* Per-file error initialization. */
112 : :
113 : : void
114 : 29608 : gfc_error_init_1 (void)
115 : : {
116 : 29608 : terminal_width = gfc_get_terminal_width ();
117 : 29608 : gfc_buffer_error (false);
118 : 29608 : }
119 : :
120 : :
121 : : /* Set the flag for buffering errors or not. */
122 : :
123 : : void
124 : 5651421 : gfc_buffer_error (bool flag)
125 : : {
126 : 5651421 : buffered_p = flag;
127 : 5651421 : }
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, TYPE_SIZE,
540 : : TYPE_SSIZE, TYPE_PTRDIFF, NOTYPE };
541 : 0 : struct
542 : : {
543 : : int type;
544 : : int pos;
545 : : union
546 : : {
547 : : int intval;
548 : : unsigned int uintval;
549 : : long int longintval;
550 : : unsigned long int ulongintval;
551 : : long long int llongintval;
552 : : unsigned long long int ullongintval;
553 : : HOST_WIDE_INT hwintval;
554 : : unsigned HOST_WIDE_INT hwuintval;
555 : : char charval;
556 : : const char * stringval;
557 : : size_t sizeval;
558 : : ssize_t ssizeval;
559 : : ptrdiff_t ptrdiffval;
560 : : } u;
561 : : } arg[MAX_ARGS], spec[MAX_ARGS];
562 : : /* spec is the array of specifiers, in the same order as they
563 : : appear in the format string. arg is the array of arguments,
564 : : in the same order as they appear in the va_list. */
565 : :
566 : 0 : char c;
567 : 0 : int i, n, have_l1, pos, maxpos;
568 : 0 : locus *l1, *l2, *loc;
569 : 0 : const char *format;
570 : :
571 : 0 : loc = l1 = l2 = NULL;
572 : :
573 : 0 : have_l1 = 0;
574 : 0 : pos = -1;
575 : 0 : maxpos = -1;
576 : :
577 : 0 : n = 0;
578 : 0 : format = format0;
579 : :
580 : 0 : for (i = 0; i < MAX_ARGS; i++)
581 : : {
582 : 0 : arg[i].type = NOTYPE;
583 : 0 : spec[i].pos = -1;
584 : : }
585 : :
586 : : /* First parse the format string for position specifiers. */
587 : 0 : while (*format)
588 : : {
589 : 0 : c = *format++;
590 : 0 : if (c != '%')
591 : 0 : continue;
592 : :
593 : 0 : if (*format == '%')
594 : : {
595 : 0 : format++;
596 : 0 : continue;
597 : : }
598 : :
599 : 0 : if (ISDIGIT (*format))
600 : : {
601 : : /* This is a position specifier. For example, the number
602 : : 12 in the format string "%12$d", which specifies the third
603 : : argument of the va_list, formatted in %d format.
604 : : For details, see "man 3 printf". */
605 : 0 : pos = atoi(format) - 1;
606 : 0 : gcc_assert (pos >= 0);
607 : 0 : while (ISDIGIT(*format))
608 : 0 : format++;
609 : 0 : gcc_assert (*format == '$');
610 : 0 : format++;
611 : : }
612 : : else
613 : 0 : pos++;
614 : :
615 : 0 : c = *format++;
616 : :
617 : 0 : if (pos > maxpos)
618 : : maxpos = pos;
619 : :
620 : 0 : switch (c)
621 : : {
622 : 0 : case 'C':
623 : 0 : arg[pos].type = TYPE_CURRENTLOC;
624 : 0 : break;
625 : :
626 : 0 : case 'L':
627 : 0 : arg[pos].type = TYPE_LOCUS;
628 : 0 : break;
629 : :
630 : 0 : case 'd':
631 : 0 : case 'i':
632 : 0 : arg[pos].type = TYPE_INTEGER;
633 : 0 : break;
634 : :
635 : 0 : case 'u':
636 : 0 : arg[pos].type = TYPE_UINTEGER;
637 : 0 : break;
638 : :
639 : 0 : case 'l':
640 : 0 : c = *format++;
641 : 0 : if (c == 'l')
642 : : {
643 : 0 : c = *format++;
644 : 0 : if (c == 'u')
645 : 0 : arg[pos].type = TYPE_ULLONGINT;
646 : 0 : else if (c == 'i' || c == 'd')
647 : 0 : arg[pos].type = TYPE_LLONGINT;
648 : : else
649 : 0 : gcc_unreachable ();
650 : : }
651 : 0 : else if (c == 'u')
652 : 0 : arg[pos].type = TYPE_ULONGINT;
653 : 0 : else if (c == 'i' || c == 'd')
654 : 0 : arg[pos].type = TYPE_LONGINT;
655 : : else
656 : 0 : gcc_unreachable ();
657 : : break;
658 : :
659 : 0 : case 'w':
660 : 0 : c = *format++;
661 : 0 : if (c == 'u')
662 : 0 : arg[pos].type = TYPE_HWUINT;
663 : 0 : else if (c == 'i' || c == 'd')
664 : 0 : arg[pos].type = TYPE_HWINT;
665 : : else
666 : 0 : gcc_unreachable ();
667 : : break;
668 : :
669 : 0 : case 'z':
670 : 0 : c = *format++;
671 : 0 : if (c == 'u')
672 : 0 : arg[pos].type = TYPE_SIZE;
673 : 0 : else if (c == 'i' || c == 'd')
674 : 0 : arg[pos].type = TYPE_SSIZE;
675 : : else
676 : 0 : gcc_unreachable ();
677 : : break;
678 : :
679 : 0 : case 't':
680 : 0 : c = *format++;
681 : 0 : if (c == 'u' || c == 'i' || c == 'd')
682 : 0 : arg[pos].type = TYPE_PTRDIFF;
683 : : else
684 : 0 : gcc_unreachable ();
685 : 0 : break;
686 : :
687 : 0 : case 'c':
688 : 0 : arg[pos].type = TYPE_CHAR;
689 : 0 : break;
690 : :
691 : 0 : case 's':
692 : 0 : arg[pos].type = TYPE_STRING;
693 : 0 : break;
694 : :
695 : 0 : default:
696 : 0 : gcc_unreachable ();
697 : : }
698 : :
699 : 0 : spec[n++].pos = pos;
700 : : }
701 : :
702 : : /* Then convert the values for each %-style argument. */
703 : 0 : for (pos = 0; pos <= maxpos; pos++)
704 : : {
705 : 0 : gcc_assert (arg[pos].type != NOTYPE);
706 : 0 : switch (arg[pos].type)
707 : : {
708 : 0 : case TYPE_CURRENTLOC:
709 : 0 : loc = &gfc_current_locus;
710 : : /* Fall through. */
711 : :
712 : 0 : case TYPE_LOCUS:
713 : 0 : if (arg[pos].type == TYPE_LOCUS)
714 : 0 : loc = va_arg (argp, locus *);
715 : :
716 : 0 : if (have_l1)
717 : : {
718 : 0 : l2 = loc;
719 : 0 : arg[pos].u.stringval = "(2)";
720 : : /* Point %C first offending character not the last good one. */
721 : 0 : if (arg[pos].type == TYPE_CURRENTLOC && *l2->nextc != '\0')
722 : 0 : l2->nextc++;
723 : : }
724 : : else
725 : : {
726 : 0 : l1 = loc;
727 : 0 : have_l1 = 1;
728 : 0 : arg[pos].u.stringval = "(1)";
729 : : /* Point %C first offending character not the last good one. */
730 : 0 : if (arg[pos].type == TYPE_CURRENTLOC && *l1->nextc != '\0')
731 : 0 : l1->nextc++;
732 : : }
733 : : break;
734 : :
735 : 0 : case TYPE_INTEGER:
736 : 0 : arg[pos].u.intval = va_arg (argp, int);
737 : 0 : break;
738 : :
739 : 0 : case TYPE_UINTEGER:
740 : 0 : arg[pos].u.uintval = va_arg (argp, unsigned int);
741 : 0 : break;
742 : :
743 : 0 : case TYPE_LONGINT:
744 : 0 : arg[pos].u.longintval = va_arg (argp, long int);
745 : 0 : break;
746 : :
747 : 0 : case TYPE_ULONGINT:
748 : 0 : arg[pos].u.ulongintval = va_arg (argp, unsigned long int);
749 : 0 : break;
750 : :
751 : 0 : case TYPE_LLONGINT:
752 : 0 : arg[pos].u.llongintval = va_arg (argp, long long int);
753 : 0 : break;
754 : :
755 : 0 : case TYPE_ULLONGINT:
756 : 0 : arg[pos].u.ullongintval = va_arg (argp, unsigned long long int);
757 : 0 : break;
758 : :
759 : 0 : case TYPE_HWINT:
760 : 0 : arg[pos].u.hwintval = va_arg (argp, HOST_WIDE_INT);
761 : 0 : break;
762 : :
763 : 0 : case TYPE_HWUINT:
764 : 0 : arg[pos].u.hwuintval = va_arg (argp, unsigned HOST_WIDE_INT);
765 : 0 : break;
766 : :
767 : 0 : case TYPE_SSIZE:
768 : 0 : arg[pos].u.ssizeval = va_arg (argp, ssize_t);
769 : 0 : break;
770 : :
771 : 0 : case TYPE_SIZE:
772 : 0 : arg[pos].u.sizeval = va_arg (argp, size_t);
773 : 0 : break;
774 : :
775 : 0 : case TYPE_PTRDIFF:
776 : 0 : arg[pos].u.ptrdiffval = va_arg (argp, ptrdiff_t);
777 : 0 : break;
778 : :
779 : 0 : case TYPE_CHAR:
780 : 0 : arg[pos].u.charval = (char) va_arg (argp, int);
781 : 0 : break;
782 : :
783 : 0 : case TYPE_STRING:
784 : 0 : arg[pos].u.stringval = (const char *) va_arg (argp, char *);
785 : 0 : break;
786 : :
787 : 0 : default:
788 : 0 : gcc_unreachable ();
789 : : }
790 : : }
791 : :
792 : 0 : for (n = 0; spec[n].pos >= 0; n++)
793 : : spec[n].u = arg[spec[n].pos].u;
794 : :
795 : : /* Show the current loci if we have to. */
796 : 0 : if (have_l1)
797 : 0 : show_loci (l1, l2);
798 : :
799 : 0 : if (*type)
800 : : {
801 : 0 : error_string (type);
802 : 0 : error_char (' ');
803 : : }
804 : :
805 : 0 : have_l1 = 0;
806 : 0 : format = format0;
807 : 0 : n = 0;
808 : :
809 : 0 : for (; *format; format++)
810 : : {
811 : : if (*format != '%')
812 : : {
813 : : error_char (*format);
814 : : continue;
815 : : }
816 : :
817 : : format++;
818 : : if (ISDIGIT (*format))
819 : : {
820 : : /* This is a position specifier. See comment above. */
821 : : while (ISDIGIT (*format))
822 : : format++;
823 : :
824 : : /* Skip over the dollar sign. */
825 : : format++;
826 : : }
827 : :
828 : : switch (*format)
829 : : {
830 : : case '%':
831 : : error_char ('%');
832 : : break;
833 : :
834 : : case 'c':
835 : : error_char (spec[n++].u.charval);
836 : : break;
837 : :
838 : : case 's':
839 : : case 'C': /* Current locus */
840 : : case 'L': /* Specified locus */
841 : : error_string (spec[n++].u.stringval);
842 : : break;
843 : :
844 : : case 'd':
845 : : case 'i':
846 : : error_integer (spec[n++].u.intval);
847 : : break;
848 : :
849 : : case 'u':
850 : : error_uinteger (spec[n++].u.uintval);
851 : : break;
852 : :
853 : : case 'l':
854 : : format++;
855 : : if (*format == 'l')
856 : : {
857 : : format++;
858 : : if (*format == 'u')
859 : : error_uinteger (spec[n++].u.ullongintval);
860 : : else
861 : : error_integer (spec[n++].u.llongintval);
862 : : }
863 : : if (*format == 'u')
864 : : error_uinteger (spec[n++].u.ulongintval);
865 : : else
866 : : error_integer (spec[n++].u.longintval);
867 : : break;
868 : :
869 : : case 'w':
870 : : format++;
871 : : if (*format == 'u')
872 : : error_hwuint (spec[n++].u.hwintval);
873 : : else
874 : : error_hwint (spec[n++].u.hwuintval);
875 : : break;
876 : :
877 : : case 'z':
878 : : format++;
879 : : if (*format == 'u')
880 : : error_uinteger (spec[n++].u.sizeval);
881 : : else
882 : : error_integer (spec[n++].u.ssizeval);
883 : : break;
884 : :
885 : : case 't':
886 : : format++;
887 : : if (*format == 'u')
888 : : {
889 : : unsigned long long a = spec[n++].u.ptrdiffval, m;
890 : : #ifdef PTRDIFF_MAX
891 : : m = PTRDIFF_MAX;
892 : : #else
893 : : m = INTTYPE_MAXIMUM (ptrdiff_t);
894 : : #endif
895 : : m = 2 * m + 1;
896 : : error_uinteger (a & m);
897 : : }
898 : : else
899 : : error_integer (spec[n++].u.ptrdiffval);
900 : : break;
901 : : }
902 : : }
903 : :
904 : 0 : error_char ('\n');
905 : 0 : }
906 : :
907 : :
908 : : /* Wrapper for error_print(). */
909 : :
910 : : static void
911 : 0 : error_printf (const char *gmsgid, ...)
912 : : {
913 : 0 : va_list argp;
914 : :
915 : 0 : va_start (argp, gmsgid);
916 : 0 : error_print ("", _(gmsgid), argp);
917 : 0 : va_end (argp);
918 : 0 : }
919 : :
920 : :
921 : : /* Clear any output buffered in a pretty-print output_buffer. */
922 : :
923 : : static void
924 : 20402243 : gfc_clear_pp_buffer (output_buffer *this_buffer)
925 : : {
926 : 20402243 : pretty_printer *pp = global_dc->printer;
927 : 20402243 : output_buffer *tmp_buffer = pp->buffer;
928 : 20402243 : pp->buffer = this_buffer;
929 : 20402243 : pp_clear_output_area (pp);
930 : 20402243 : pp->buffer = tmp_buffer;
931 : : /* We need to reset last_location, otherwise we may skip caret lines
932 : : when we actually give a diagnostic. */
933 : 20402243 : global_dc->m_last_location = UNKNOWN_LOCATION;
934 : 20402243 : }
935 : :
936 : : /* The currently-printing diagnostic, for use by gfc_format_decoder,
937 : : for colorizing %C and %L. */
938 : :
939 : : static diagnostic_info *curr_diagnostic;
940 : :
941 : : /* A helper function to call diagnostic_report_diagnostic, while setting
942 : : curr_diagnostic for the duration of the call. */
943 : :
944 : : static bool
945 : 1104813 : gfc_report_diagnostic (diagnostic_info *diagnostic)
946 : : {
947 : 1104813 : gcc_assert (diagnostic != NULL);
948 : 1104813 : curr_diagnostic = diagnostic;
949 : 1104813 : bool ret = diagnostic_report_diagnostic (global_dc, diagnostic);
950 : 1104805 : curr_diagnostic = NULL;
951 : 1104805 : return ret;
952 : : }
953 : :
954 : : /* This is just a helper function to avoid duplicating the logic of
955 : : gfc_warning. */
956 : :
957 : : static bool
958 : 19116 : gfc_warning (int opt, const char *gmsgid, va_list ap)
959 : : {
960 : 19116 : va_list argp;
961 : 19116 : va_copy (argp, ap);
962 : :
963 : 19116 : diagnostic_info diagnostic;
964 : 19116 : rich_location rich_loc (line_table, UNKNOWN_LOCATION);
965 : 19116 : bool fatal_errors = global_dc->m_fatal_errors;
966 : 19116 : pretty_printer *pp = global_dc->printer;
967 : 19116 : output_buffer *tmp_buffer = pp->buffer;
968 : :
969 : 19116 : gfc_clear_pp_buffer (pp_warning_buffer);
970 : :
971 : 19116 : if (buffered_p)
972 : : {
973 : 15376 : pp->buffer = pp_warning_buffer;
974 : 15376 : global_dc->m_fatal_errors = false;
975 : : /* To prevent -fmax-errors= triggering. */
976 : 15376 : --werrorcount;
977 : : }
978 : :
979 : 19116 : diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc,
980 : : DK_WARNING);
981 : 19116 : diagnostic.option_index = opt;
982 : 19116 : bool ret = gfc_report_diagnostic (&diagnostic);
983 : :
984 : 19116 : if (buffered_p)
985 : : {
986 : 15376 : pp->buffer = tmp_buffer;
987 : 15376 : global_dc->m_fatal_errors = fatal_errors;
988 : :
989 : 15376 : warningcount_buffered = 0;
990 : 15376 : werrorcount_buffered = 0;
991 : : /* Undo the above --werrorcount if not Werror, otherwise
992 : : werrorcount is correct already. */
993 : 15376 : if (!ret)
994 : 12 : ++werrorcount;
995 : 15364 : else if (diagnostic.kind == DK_ERROR)
996 : 1 : ++werrorcount_buffered;
997 : : else
998 : 15363 : ++werrorcount, --warningcount, ++warningcount_buffered;
999 : : }
1000 : :
1001 : 19116 : va_end (argp);
1002 : 38232 : return ret;
1003 : 19116 : }
1004 : :
1005 : : /* Issue a warning. */
1006 : :
1007 : : bool
1008 : 3612 : gfc_warning (int opt, const char *gmsgid, ...)
1009 : : {
1010 : 3612 : va_list argp;
1011 : :
1012 : 3612 : va_start (argp, gmsgid);
1013 : 3612 : bool ret = gfc_warning (opt, gmsgid, argp);
1014 : 3612 : va_end (argp);
1015 : 3612 : return ret;
1016 : : }
1017 : :
1018 : :
1019 : : /* Whether, for a feature included in a given standard set (GFC_STD_*),
1020 : : we should issue an error or a warning, or be quiet. */
1021 : :
1022 : : notification
1023 : 231336 : gfc_notification_std (int std)
1024 : : {
1025 : 231336 : bool warning;
1026 : :
1027 : 231336 : warning = ((gfc_option.warn_std & std) != 0) && !inhibit_warnings;
1028 : 231336 : if ((gfc_option.allow_std & std) != 0 && !warning)
1029 : : return SILENT;
1030 : :
1031 : 384 : return warning ? WARNING : ERROR;
1032 : : }
1033 : :
1034 : :
1035 : : /* Return a string describing the nature of a standard violation
1036 : : * and/or the relevant version of the standard. */
1037 : :
1038 : : char const*
1039 : 16205 : notify_std_msg(int std)
1040 : : {
1041 : :
1042 : 16205 : if (std & GFC_STD_F2023_DEL)
1043 : 10 : return _("Prohibited in Fortran 2023:");
1044 : 16195 : else if (std & GFC_STD_F2023)
1045 : 5 : return _("Fortran 2023:");
1046 : 16190 : else if (std & GFC_STD_F2018_DEL)
1047 : 1 : return _("Fortran 2018 deleted feature:");
1048 : 16189 : else if (std & GFC_STD_F2018_OBS)
1049 : 8 : return _("Fortran 2018 obsolescent feature:");
1050 : 16181 : else if (std & GFC_STD_F2018)
1051 : 118 : return _("Fortran 2018:");
1052 : 16063 : else if (std & GFC_STD_F2008_OBS)
1053 : 2 : return _("Fortran 2008 obsolescent feature:");
1054 : 16061 : else if (std & GFC_STD_F2008)
1055 : : return "Fortran 2008:";
1056 : 15670 : else if (std & GFC_STD_F2003)
1057 : : return "Fortran 2003:";
1058 : 15544 : else if (std & GFC_STD_GNU)
1059 : 393 : return _("GNU Extension:");
1060 : 15151 : else if (std & GFC_STD_LEGACY)
1061 : 11549 : return _("Legacy Extension:");
1062 : 3602 : else if (std & GFC_STD_F95_OBS)
1063 : 3472 : return _("Obsolescent feature:");
1064 : 130 : else if (std & GFC_STD_F95_DEL)
1065 : 130 : return _("Deleted feature:");
1066 : : else
1067 : 0 : gcc_unreachable ();
1068 : : }
1069 : :
1070 : :
1071 : : /* Possibly issue a warning/error about use of a nonstandard (or deleted)
1072 : : feature. An error/warning will be issued if the currently selected
1073 : : standard does not contain the requested bits. Return false if
1074 : : an error is generated. */
1075 : :
1076 : : bool
1077 : 290499 : gfc_notify_std (int std, const char *gmsgid, ...)
1078 : : {
1079 : 290499 : va_list argp;
1080 : 290499 : const char *msg, *msg2;
1081 : 290499 : char *buffer;
1082 : :
1083 : : /* Determine whether an error or a warning is needed. */
1084 : 290499 : const int wstd = std & gfc_option.warn_std; /* Standard to warn about. */
1085 : 290499 : const int estd = std & ~gfc_option.allow_std; /* Standard to error about. */
1086 : 290499 : const bool warning = (wstd != 0) && !inhibit_warnings;
1087 : 290499 : const bool error = (estd != 0);
1088 : :
1089 : 290499 : if (!error && !warning)
1090 : : return true;
1091 : 16206 : if (suppress_errors)
1092 : : return !error;
1093 : :
1094 : 16205 : if (error)
1095 : 745 : msg = notify_std_msg (estd);
1096 : : else
1097 : 15460 : msg = notify_std_msg (wstd);
1098 : :
1099 : 16205 : msg2 = _(gmsgid);
1100 : 16205 : buffer = (char *) alloca (strlen (msg) + strlen (msg2) + 2);
1101 : 16205 : strcpy (buffer, msg);
1102 : 16205 : strcat (buffer, " ");
1103 : 16205 : strcat (buffer, msg2);
1104 : :
1105 : 16205 : va_start (argp, gmsgid);
1106 : 16205 : if (error)
1107 : 745 : gfc_error_opt (0, buffer, argp);
1108 : : else
1109 : 15460 : gfc_warning (0, buffer, argp);
1110 : 16205 : va_end (argp);
1111 : :
1112 : 16205 : if (error)
1113 : : return false;
1114 : : else
1115 : 15463 : return (warning && !warnings_are_errors);
1116 : : }
1117 : :
1118 : :
1119 : : /* Called from output_format -- during diagnostic message processing
1120 : : to handle Fortran specific format specifiers with the following meanings:
1121 : :
1122 : : %C Current locus (no argument)
1123 : : %L Takes locus argument
1124 : : */
1125 : : static bool
1126 : 1080913 : gfc_format_decoder (pretty_printer *pp, text_info *text, const char *spec,
1127 : : int precision, bool wide, bool set_locus, bool hash,
1128 : : bool *quoted, const char **buffer_ptr)
1129 : : {
1130 : 1080913 : switch (*spec)
1131 : : {
1132 : 1080890 : case 'C':
1133 : 1080890 : case 'L':
1134 : 1080890 : {
1135 : 1080890 : static const char *result[2] = { "(1)", "(2)" };
1136 : 1080890 : locus *loc;
1137 : 1080890 : if (*spec == 'C')
1138 : : loc = &gfc_current_locus;
1139 : : else
1140 : 14858 : loc = va_arg (*text->m_args_ptr, locus *);
1141 : 1080890 : gcc_assert (loc->nextc - loc->lb->line >= 0);
1142 : 1080890 : unsigned int offset = loc->nextc - loc->lb->line;
1143 : 1080890 : if (*spec == 'C' && *loc->nextc != '\0')
1144 : : /* Point %C first offending character not the last good one. */
1145 : 1008917 : offset++;
1146 : : /* If location[0] != UNKNOWN_LOCATION means that we already
1147 : : processed one of %C/%L. */
1148 : 1080890 : int loc_num = text->get_location (0) == UNKNOWN_LOCATION ? 0 : 1;
1149 : 1080890 : location_t src_loc
1150 : 2161780 : = linemap_position_for_loc_and_offset (line_table,
1151 : 1080890 : loc->lb->location,
1152 : : offset);
1153 : 1080890 : text->set_location (loc_num, src_loc, SHOW_RANGE_WITH_CARET);
1154 : : /* Colorize the markers to match the color choices of
1155 : : diagnostic_show_locus (the initial location has a color given
1156 : : by the "kind" of the diagnostic, the secondary location has
1157 : : color "range1"). */
1158 : 1080890 : gcc_assert (curr_diagnostic != NULL);
1159 : 1080890 : const char *color
1160 : : = (loc_num
1161 : 1080890 : ? "range1"
1162 : 1080449 : : diagnostic_get_color_for_kind (curr_diagnostic->kind));
1163 : 1080890 : pp_string (pp, colorize_start (pp_show_color (pp), color));
1164 : 1080890 : pp_string (pp, result[loc_num]);
1165 : 1080890 : pp_string (pp, colorize_stop (pp_show_color (pp)));
1166 : 1080890 : return true;
1167 : : }
1168 : 23 : default:
1169 : : /* Fall through info the middle-end decoder, as e.g. stor-layout.cc
1170 : : etc. diagnostics can use the FE printer while the FE is still
1171 : : active. */
1172 : 23 : return default_tree_printer (pp, text, spec, precision, wide,
1173 : 23 : set_locus, hash, quoted, buffer_ptr);
1174 : : }
1175 : : }
1176 : :
1177 : : /* Return a malloc'd string describing the kind of diagnostic. The
1178 : : caller is responsible for freeing the memory. */
1179 : : static char *
1180 : 1083092 : gfc_diagnostic_build_kind_prefix (diagnostic_context *context,
1181 : : const diagnostic_info *diagnostic)
1182 : : {
1183 : 1083092 : static const char *const diagnostic_kind_text[] = {
1184 : : #define DEFINE_DIAGNOSTIC_KIND(K, T, C) (T),
1185 : : #include "gfc-diagnostic.def"
1186 : : #undef DEFINE_DIAGNOSTIC_KIND
1187 : : "must-not-happen"
1188 : : };
1189 : 1083092 : static const char *const diagnostic_kind_color[] = {
1190 : : #define DEFINE_DIAGNOSTIC_KIND(K, T, C) (C),
1191 : : #include "gfc-diagnostic.def"
1192 : : #undef DEFINE_DIAGNOSTIC_KIND
1193 : : NULL
1194 : : };
1195 : 1083092 : gcc_assert (diagnostic->kind < DK_LAST_DIAGNOSTIC_KIND);
1196 : 1083092 : const char *text = _(diagnostic_kind_text[diagnostic->kind]);
1197 : 1083092 : const char *text_cs = "", *text_ce = "";
1198 : 1083092 : pretty_printer *pp = context->printer;
1199 : :
1200 : 1083092 : if (diagnostic_kind_color[diagnostic->kind])
1201 : : {
1202 : 1083092 : text_cs = colorize_start (pp_show_color (pp),
1203 : : diagnostic_kind_color[diagnostic->kind]);
1204 : 1083092 : text_ce = colorize_stop (pp_show_color (pp));
1205 : : }
1206 : 1083092 : return build_message_string ("%s%s:%s ", text_cs, text, text_ce);
1207 : : }
1208 : :
1209 : : /* Return a malloc'd string describing a location. The caller is
1210 : : responsible for freeing the memory. */
1211 : : static char *
1212 : 1083228 : gfc_diagnostic_build_locus_prefix (diagnostic_context *context,
1213 : : expanded_location s)
1214 : : {
1215 : 1083228 : pretty_printer *pp = context->printer;
1216 : 1083228 : const char *locus_cs = colorize_start (pp_show_color (pp), "locus");
1217 : 1083228 : const char *locus_ce = colorize_stop (pp_show_color (pp));
1218 : 1083228 : return (s.file == NULL
1219 : 1083228 : ? build_message_string ("%s%s:%s", locus_cs, progname, locus_ce )
1220 : 1083165 : : !strcmp (s.file, special_fname_builtin ())
1221 : 1083165 : ? build_message_string ("%s%s:%s", locus_cs, s.file, locus_ce)
1222 : 1083155 : : context->m_show_column
1223 : 1083155 : ? build_message_string ("%s%s:%d:%d:%s", locus_cs, s.file, s.line,
1224 : : s.column, locus_ce)
1225 : 0 : : build_message_string ("%s%s:%d:%s", locus_cs, s.file, s.line, locus_ce));
1226 : : }
1227 : :
1228 : : /* Return a malloc'd string describing two locations. The caller is
1229 : : responsible for freeing the memory. */
1230 : : static char *
1231 : 152 : gfc_diagnostic_build_locus_prefix (diagnostic_context *context,
1232 : : expanded_location s, expanded_location s2)
1233 : : {
1234 : 152 : pretty_printer *pp = context->printer;
1235 : 152 : const char *locus_cs = colorize_start (pp_show_color (pp), "locus");
1236 : 152 : const char *locus_ce = colorize_stop (pp_show_color (pp));
1237 : :
1238 : 152 : return (s.file == NULL
1239 : 152 : ? build_message_string ("%s%s:%s", locus_cs, progname, locus_ce )
1240 : 152 : : !strcmp (s.file, special_fname_builtin ())
1241 : 152 : ? build_message_string ("%s%s:%s", locus_cs, s.file, locus_ce)
1242 : 152 : : context->m_show_column
1243 : 152 : ? build_message_string ("%s%s:%d:%d-%d:%s", locus_cs, s.file, s.line,
1244 : : MIN (s.column, s2.column),
1245 : : MAX (s.column, s2.column), locus_ce)
1246 : 0 : : build_message_string ("%s%s:%d:%s", locus_cs, s.file, s.line,
1247 : 152 : locus_ce));
1248 : : }
1249 : :
1250 : : /* This function prints the locus (file:line:column), the diagnostic kind
1251 : : (Error, Warning) and (optionally) the relevant lines of code with
1252 : : annotation lines with '1' and/or '2' below them.
1253 : :
1254 : : With -fdiagnostic-show-caret (the default) it prints:
1255 : :
1256 : : [locus of primary range]:
1257 : :
1258 : : some code
1259 : : 1
1260 : : Error: Some error at (1)
1261 : :
1262 : : With -fno-diagnostic-show-caret or if the primary range is not
1263 : : valid, it prints:
1264 : :
1265 : : [locus of primary range]: Error: Some error at (1) and (2)
1266 : : */
1267 : : static void
1268 : 1083092 : gfc_diagnostic_starter (diagnostic_context *context,
1269 : : const diagnostic_info *diagnostic)
1270 : : {
1271 : 1083092 : char * kind_prefix = gfc_diagnostic_build_kind_prefix (context, diagnostic);
1272 : :
1273 : 1083092 : expanded_location s1 = diagnostic_expand_location (diagnostic);
1274 : 1083092 : expanded_location s2;
1275 : 1083092 : bool one_locus = diagnostic->richloc->get_num_locations () < 2;
1276 : 1083092 : bool same_locus = false;
1277 : :
1278 : 1083092 : if (!one_locus)
1279 : : {
1280 : 441 : s2 = diagnostic_expand_location (diagnostic, 1);
1281 : 882 : same_locus = diagnostic_same_line (context, s1, s2);
1282 : : }
1283 : :
1284 : 1083092 : char * locus_prefix = (one_locus || !same_locus)
1285 : 1083092 : ? gfc_diagnostic_build_locus_prefix (context, s1)
1286 : 152 : : gfc_diagnostic_build_locus_prefix (context, s1, s2);
1287 : :
1288 : 1083092 : if (!context->m_source_printing.enabled
1289 : 16128 : || diagnostic_location (diagnostic, 0) <= BUILTINS_LOCATION
1290 : 1099220 : || diagnostic_location (diagnostic, 0) == context->m_last_location)
1291 : : {
1292 : 1066964 : pp_set_prefix (context->printer,
1293 : : concat (locus_prefix, " ", kind_prefix, NULL));
1294 : 1066964 : free (locus_prefix);
1295 : :
1296 : 1066964 : if (one_locus || same_locus)
1297 : : {
1298 : 1066677 : free (kind_prefix);
1299 : 1066677 : return;
1300 : : }
1301 : : /* In this case, we print the previous locus and prefix as:
1302 : :
1303 : : [locus]:[prefix]: (1)
1304 : :
1305 : : and we flush with a new line before setting the new prefix. */
1306 : 287 : pp_string (context->printer, "(1)");
1307 : 287 : pp_newline (context->printer);
1308 : 287 : locus_prefix = gfc_diagnostic_build_locus_prefix (context, s2);
1309 : 287 : pp_set_prefix (context->printer,
1310 : : concat (locus_prefix, " ", kind_prefix, NULL));
1311 : 287 : free (kind_prefix);
1312 : 287 : free (locus_prefix);
1313 : : }
1314 : : else
1315 : : {
1316 : 16128 : pp_verbatim (context->printer, "%s", locus_prefix);
1317 : 16128 : free (locus_prefix);
1318 : : /* Fortran uses an empty line between locus and caret line. */
1319 : 16128 : pp_newline (context->printer);
1320 : 16128 : pp_set_prefix (context->printer, NULL);
1321 : 16128 : pp_newline (context->printer);
1322 : 16128 : diagnostic_show_locus (context, diagnostic->richloc, diagnostic->kind);
1323 : : /* If the caret line was shown, the prefix does not contain the
1324 : : locus. */
1325 : 16128 : pp_set_prefix (context->printer, kind_prefix);
1326 : : }
1327 : : }
1328 : :
1329 : : static void
1330 : 1 : gfc_diagnostic_start_span (diagnostic_context *context,
1331 : : expanded_location exploc)
1332 : : {
1333 : 1 : char *locus_prefix;
1334 : 1 : locus_prefix = gfc_diagnostic_build_locus_prefix (context, exploc);
1335 : 1 : pp_verbatim (context->printer, "%s", locus_prefix);
1336 : 1 : free (locus_prefix);
1337 : 1 : pp_newline (context->printer);
1338 : : /* Fortran uses an empty line between locus and caret line. */
1339 : 1 : pp_newline (context->printer);
1340 : 1 : }
1341 : :
1342 : :
1343 : : static void
1344 : 1083092 : gfc_diagnostic_finalizer (diagnostic_context *context,
1345 : : const diagnostic_info *diagnostic ATTRIBUTE_UNUSED,
1346 : : diagnostic_t orig_diag_kind ATTRIBUTE_UNUSED)
1347 : : {
1348 : 1083092 : pp_destroy_prefix (context->printer);
1349 : 1083092 : pp_newline_and_flush (context->printer);
1350 : 1083092 : }
1351 : :
1352 : : /* Immediate warning (i.e. do not buffer the warning) with an explicit
1353 : : location. */
1354 : :
1355 : : bool
1356 : 3 : gfc_warning_now_at (location_t loc, int opt, const char *gmsgid, ...)
1357 : : {
1358 : 3 : va_list argp;
1359 : 3 : diagnostic_info diagnostic;
1360 : 3 : rich_location rich_loc (line_table, loc);
1361 : 3 : bool ret;
1362 : :
1363 : 3 : va_start (argp, gmsgid);
1364 : 3 : diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc, DK_WARNING);
1365 : 3 : diagnostic.option_index = opt;
1366 : 3 : ret = gfc_report_diagnostic (&diagnostic);
1367 : 3 : va_end (argp);
1368 : 6 : return ret;
1369 : 3 : }
1370 : :
1371 : : /* Immediate warning (i.e. do not buffer the warning). */
1372 : :
1373 : : bool
1374 : 23504 : gfc_warning_now (int opt, const char *gmsgid, ...)
1375 : : {
1376 : 23504 : va_list argp;
1377 : 23504 : diagnostic_info diagnostic;
1378 : 23504 : rich_location rich_loc (line_table, UNKNOWN_LOCATION);
1379 : 23504 : bool ret;
1380 : :
1381 : 23504 : va_start (argp, gmsgid);
1382 : 23504 : diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc,
1383 : : DK_WARNING);
1384 : 23504 : diagnostic.option_index = opt;
1385 : 23504 : ret = gfc_report_diagnostic (&diagnostic);
1386 : 23504 : va_end (argp);
1387 : 47008 : return ret;
1388 : 23504 : }
1389 : :
1390 : : /* Internal warning, do not buffer. */
1391 : :
1392 : : bool
1393 : 0 : gfc_warning_internal (int opt, const char *gmsgid, ...)
1394 : : {
1395 : 0 : va_list argp;
1396 : 0 : diagnostic_info diagnostic;
1397 : 0 : rich_location rich_loc (line_table, UNKNOWN_LOCATION);
1398 : 0 : bool ret;
1399 : :
1400 : 0 : va_start (argp, gmsgid);
1401 : 0 : diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc,
1402 : : DK_WARNING);
1403 : 0 : diagnostic.option_index = opt;
1404 : 0 : ret = gfc_report_diagnostic (&diagnostic);
1405 : 0 : va_end (argp);
1406 : 0 : return ret;
1407 : 0 : }
1408 : :
1409 : : /* Immediate error (i.e. do not buffer). */
1410 : :
1411 : : void
1412 : 392 : gfc_error_now (const char *gmsgid, ...)
1413 : : {
1414 : 392 : va_list argp;
1415 : 392 : diagnostic_info diagnostic;
1416 : 392 : rich_location rich_loc (line_table, UNKNOWN_LOCATION);
1417 : :
1418 : 392 : error_buffer.flag = true;
1419 : :
1420 : 392 : va_start (argp, gmsgid);
1421 : 392 : diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc, DK_ERROR);
1422 : 392 : gfc_report_diagnostic (&diagnostic);
1423 : 392 : va_end (argp);
1424 : 392 : }
1425 : :
1426 : :
1427 : : /* Fatal error, never returns. */
1428 : :
1429 : : void
1430 : 8 : gfc_fatal_error (const char *gmsgid, ...)
1431 : : {
1432 : 8 : va_list argp;
1433 : 8 : diagnostic_info diagnostic;
1434 : 8 : rich_location rich_loc (line_table, UNKNOWN_LOCATION);
1435 : :
1436 : 8 : va_start (argp, gmsgid);
1437 : 8 : diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc, DK_FATAL);
1438 : 8 : gfc_report_diagnostic (&diagnostic);
1439 : 0 : va_end (argp);
1440 : :
1441 : 0 : gcc_unreachable ();
1442 : : }
1443 : :
1444 : : /* Clear the warning flag. */
1445 : :
1446 : : void
1447 : 11897827 : gfc_clear_warning (void)
1448 : : {
1449 : 11897827 : gfc_clear_pp_buffer (pp_warning_buffer);
1450 : 11897827 : warningcount_buffered = 0;
1451 : 11897827 : werrorcount_buffered = 0;
1452 : 11897827 : }
1453 : :
1454 : :
1455 : : /* Check to see if any warnings have been saved.
1456 : : If so, print the warning. */
1457 : :
1458 : : void
1459 : 1157852 : gfc_warning_check (void)
1460 : : {
1461 : 1161807 : if (! gfc_output_buffer_empty_p (pp_warning_buffer))
1462 : : {
1463 : 3955 : pretty_printer *pp = global_dc->printer;
1464 : 3955 : output_buffer *tmp_buffer = pp->buffer;
1465 : 3955 : pp->buffer = pp_warning_buffer;
1466 : 3955 : pp_really_flush (pp);
1467 : 3955 : warningcount += warningcount_buffered;
1468 : 3955 : werrorcount += werrorcount_buffered;
1469 : 3955 : gcc_assert (warningcount_buffered + werrorcount_buffered == 1);
1470 : 3955 : pp->buffer = tmp_buffer;
1471 : 3955 : diagnostic_action_after_output (global_dc,
1472 : : warningcount_buffered
1473 : : ? DK_WARNING : DK_ERROR);
1474 : 3955 : diagnostic_check_max_errors (global_dc, true);
1475 : : }
1476 : 1157852 : }
1477 : :
1478 : :
1479 : : /* Issue an error. */
1480 : :
1481 : : static void
1482 : 1078323 : gfc_error_opt (int opt, const char *gmsgid, va_list ap)
1483 : : {
1484 : 1078323 : va_list argp;
1485 : 1078323 : va_copy (argp, ap);
1486 : 1078323 : bool saved_abort_on_error = false;
1487 : :
1488 : 1078323 : if (warnings_not_errors)
1489 : : {
1490 : 44 : gfc_warning (opt, gmsgid, argp);
1491 : 44 : va_end (argp);
1492 : 16533 : return;
1493 : : }
1494 : :
1495 : 1078279 : if (suppress_errors)
1496 : : {
1497 : 16489 : va_end (argp);
1498 : 16489 : return;
1499 : : }
1500 : :
1501 : 1061790 : diagnostic_info diagnostic;
1502 : 1061790 : rich_location richloc (line_table, UNKNOWN_LOCATION);
1503 : 1061790 : bool fatal_errors = global_dc->m_fatal_errors;
1504 : 1061790 : pretty_printer *pp = global_dc->printer;
1505 : 1061790 : output_buffer *tmp_buffer = pp->buffer;
1506 : :
1507 : 1061790 : gfc_clear_pp_buffer (pp_error_buffer);
1508 : :
1509 : 1061790 : if (buffered_p)
1510 : : {
1511 : : /* To prevent -dH from triggering an abort on a buffered error,
1512 : : save abort_on_error and restore it below. */
1513 : 1055359 : saved_abort_on_error = global_dc->m_abort_on_error;
1514 : 1055359 : global_dc->m_abort_on_error = false;
1515 : 1055359 : pp->buffer = pp_error_buffer;
1516 : 1055359 : global_dc->m_fatal_errors = false;
1517 : : /* To prevent -fmax-errors= triggering, we decrease it before
1518 : : report_diagnostic increases it. */
1519 : 1055359 : --errorcount;
1520 : : }
1521 : :
1522 : 1061790 : diagnostic_set_info (&diagnostic, gmsgid, &argp, &richloc, DK_ERROR);
1523 : 1061790 : gfc_report_diagnostic (&diagnostic);
1524 : :
1525 : 1061790 : if (buffered_p)
1526 : : {
1527 : 1055359 : pp->buffer = tmp_buffer;
1528 : 1055359 : global_dc->m_fatal_errors = fatal_errors;
1529 : 1055359 : global_dc->m_abort_on_error = saved_abort_on_error;
1530 : :
1531 : : }
1532 : :
1533 : 1061790 : va_end (argp);
1534 : 1061790 : }
1535 : :
1536 : :
1537 : : void
1538 : 246 : gfc_error_opt (int opt, const char *gmsgid, ...)
1539 : : {
1540 : 246 : va_list argp;
1541 : 246 : va_start (argp, gmsgid);
1542 : 246 : gfc_error_opt (opt, gmsgid, argp);
1543 : 246 : va_end (argp);
1544 : 246 : }
1545 : :
1546 : :
1547 : : void
1548 : 1077332 : gfc_error (const char *gmsgid, ...)
1549 : : {
1550 : 1077332 : va_list argp;
1551 : 1077332 : va_start (argp, gmsgid);
1552 : 1077332 : gfc_error_opt (0, gmsgid, argp);
1553 : 1077332 : va_end (argp);
1554 : 1077332 : }
1555 : :
1556 : :
1557 : : /* This shouldn't happen... but sometimes does. */
1558 : :
1559 : : void
1560 : 0 : gfc_internal_error (const char *gmsgid, ...)
1561 : : {
1562 : 0 : int e, w;
1563 : 0 : va_list argp;
1564 : 0 : diagnostic_info diagnostic;
1565 : 0 : rich_location rich_loc (line_table, UNKNOWN_LOCATION);
1566 : :
1567 : 0 : gfc_get_errors (&w, &e);
1568 : 0 : if (e > 0)
1569 : 0 : exit(EXIT_FAILURE);
1570 : :
1571 : 0 : va_start (argp, gmsgid);
1572 : 0 : diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc, DK_ICE);
1573 : 0 : gfc_report_diagnostic (&diagnostic);
1574 : 0 : va_end (argp);
1575 : :
1576 : 0 : gcc_unreachable ();
1577 : : }
1578 : :
1579 : :
1580 : : /* Clear the error flag when we start to compile a source line. */
1581 : :
1582 : : void
1583 : 4591062 : gfc_clear_error (void)
1584 : : {
1585 : 4591062 : error_buffer.flag = false;
1586 : 4591062 : warnings_not_errors = false;
1587 : 4591062 : gfc_clear_pp_buffer (pp_error_buffer);
1588 : 4591062 : }
1589 : :
1590 : :
1591 : : /* Tests the state of error_flag. */
1592 : :
1593 : : bool
1594 : 1468725 : gfc_error_flag_test (void)
1595 : : {
1596 : 1468725 : return error_buffer.flag
1597 : 2428147 : || !gfc_output_buffer_empty_p (pp_error_buffer);
1598 : : }
1599 : :
1600 : :
1601 : : /* Check to see if any errors have been saved.
1602 : : If so, print the error. Returns the state of error_flag. */
1603 : :
1604 : : bool
1605 : 5148 : gfc_error_check (void)
1606 : : {
1607 : 5148 : if (error_buffer.flag
1608 : 8044 : || ! gfc_output_buffer_empty_p (pp_error_buffer))
1609 : : {
1610 : 2920 : error_buffer.flag = false;
1611 : 2920 : pretty_printer *pp = global_dc->printer;
1612 : 2920 : output_buffer *tmp_buffer = pp->buffer;
1613 : 2920 : pp->buffer = pp_error_buffer;
1614 : 2920 : pp_really_flush (pp);
1615 : 2920 : ++errorcount;
1616 : 2920 : gcc_assert (gfc_output_buffer_empty_p (pp_error_buffer));
1617 : 2920 : pp->buffer = tmp_buffer;
1618 : 2920 : diagnostic_action_after_output (global_dc, DK_ERROR);
1619 : 2920 : diagnostic_check_max_errors (global_dc, true);
1620 : 2920 : return true;
1621 : : }
1622 : :
1623 : : return false;
1624 : : }
1625 : :
1626 : : /* Move the text buffered from FROM to TO, then clear
1627 : : FROM. Independently if there was text in FROM, TO is also
1628 : : cleared. */
1629 : :
1630 : : static void
1631 : 2683210 : gfc_move_error_buffer_from_to (gfc_error_buffer * buffer_from,
1632 : : gfc_error_buffer * buffer_to)
1633 : : {
1634 : 2683210 : output_buffer * from = &(buffer_from->buffer);
1635 : 2683210 : output_buffer * to = &(buffer_to->buffer);
1636 : :
1637 : 2683210 : buffer_to->flag = buffer_from->flag;
1638 : 2683210 : buffer_from->flag = false;
1639 : :
1640 : 2683210 : gfc_clear_pp_buffer (to);
1641 : : /* We make sure this is always buffered. */
1642 : 2683210 : to->flush_p = false;
1643 : :
1644 : 2774190 : if (! gfc_output_buffer_empty_p (from))
1645 : : {
1646 : 90980 : const char *str = output_buffer_formatted_text (from);
1647 : 90980 : output_buffer_append_r (to, str, strlen (str));
1648 : 90980 : gfc_clear_pp_buffer (from);
1649 : : }
1650 : 2683210 : }
1651 : :
1652 : : /* Save the existing error state. */
1653 : :
1654 : : void
1655 : 1370790 : gfc_push_error (gfc_error_buffer *err)
1656 : : {
1657 : 1370790 : gfc_move_error_buffer_from_to (&error_buffer, err);
1658 : 1370790 : }
1659 : :
1660 : :
1661 : : /* Restore a previous pushed error state. */
1662 : :
1663 : : void
1664 : 1312420 : gfc_pop_error (gfc_error_buffer *err)
1665 : : {
1666 : 1312420 : gfc_move_error_buffer_from_to (err, &error_buffer);
1667 : 1312420 : }
1668 : :
1669 : :
1670 : : /* Free a pushed error state, but keep the current error state. */
1671 : :
1672 : : void
1673 : 58258 : gfc_free_error (gfc_error_buffer *err)
1674 : : {
1675 : 58258 : gfc_clear_pp_buffer (&(err->buffer));
1676 : 58258 : }
1677 : :
1678 : :
1679 : : /* Report the number of warnings and errors that occurred to the caller. */
1680 : :
1681 : : void
1682 : 310291 : gfc_get_errors (int *w, int *e)
1683 : : {
1684 : 310291 : if (w != NULL)
1685 : 262373 : *w = warningcount + werrorcount;
1686 : 310291 : if (e != NULL)
1687 : 310291 : *e = errorcount + sorrycount + werrorcount;
1688 : 310291 : }
1689 : :
1690 : :
1691 : : /* Switch errors into warnings. */
1692 : :
1693 : : void
1694 : 46941 : gfc_errors_to_warnings (bool f)
1695 : : {
1696 : 46941 : warnings_not_errors = f;
1697 : 46941 : }
1698 : :
1699 : : void
1700 : 29609 : gfc_diagnostics_init (void)
1701 : : {
1702 : 29609 : diagnostic_starter (global_dc) = gfc_diagnostic_starter;
1703 : 29609 : diagnostic_start_span (global_dc) = gfc_diagnostic_start_span;
1704 : 29609 : diagnostic_finalizer (global_dc) = gfc_diagnostic_finalizer;
1705 : 29609 : diagnostic_format_decoder (global_dc) = gfc_format_decoder;
1706 : 29609 : global_dc->m_source_printing.caret_chars[0] = '1';
1707 : 29609 : global_dc->m_source_printing.caret_chars[1] = '2';
1708 : 29609 : pp_warning_buffer = new (XNEW (output_buffer)) output_buffer ();
1709 : 29609 : pp_warning_buffer->flush_p = false;
1710 : : /* pp_error_buffer is statically allocated. This simplifies memory
1711 : : management when using gfc_push/pop_error. */
1712 : 29609 : pp_error_buffer = &(error_buffer.buffer);
1713 : 29609 : pp_error_buffer->flush_p = false;
1714 : 29609 : }
1715 : :
1716 : : void
1717 : 29583 : gfc_diagnostics_finish (void)
1718 : : {
1719 : 29583 : tree_diagnostics_defaults (global_dc);
1720 : : /* We still want to use the gfc starter and finalizer, not the tree
1721 : : defaults. */
1722 : 29583 : diagnostic_starter (global_dc) = gfc_diagnostic_starter;
1723 : 29583 : diagnostic_finalizer (global_dc) = gfc_diagnostic_finalizer;
1724 : 29583 : global_dc->m_source_printing.caret_chars[0] = '^';
1725 : 29583 : global_dc->m_source_printing.caret_chars[1] = '^';
1726 : 29583 : }
|
