Bug Summary

File:build/gcc/fortran/error.cc
Warning:line 771, column 3
Value stored to 'have_l1' is never read

Annotated Source Code

Press '?' to see keyboard shortcuts

clang -cc1 -cc1 -triple x86_64-suse-linux -analyze -disable-free -clear-ast-before-backend -disable-llvm-verifier -discard-value-names -main-file-name error.cc -analyzer-checker=core -analyzer-checker=apiModeling -analyzer-checker=unix -analyzer-checker=deadcode -analyzer-checker=cplusplus -analyzer-checker=security.insecureAPI.UncheckedReturn -analyzer-checker=security.insecureAPI.getpw -analyzer-checker=security.insecureAPI.gets -analyzer-checker=security.insecureAPI.mktemp -analyzer-checker=security.insecureAPI.mkstemp -analyzer-checker=security.insecureAPI.vfork -analyzer-checker=nullability.NullPassedToNonnull -analyzer-checker=nullability.NullReturnedFromNonnull -analyzer-output plist -w -setup-static-analyzer -analyzer-config-compatibility-mode=true -mrelocation-model static -mframe-pointer=none -fmath-errno -ffp-contract=on -fno-rounding-math -mconstructor-aliases -funwind-tables=2 -target-cpu x86-64 -tune-cpu generic -debugger-tuning=gdb -fcoverage-compilation-dir=/buildworker/marxinbox-gcc-clang-static-analyzer/objdir/gcc -resource-dir /usr/lib64/clang/15.0.7 -D IN_GCC_FRONTEND -D IN_GCC -D HAVE_CONFIG_H -I . -I fortran -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../include -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libcpp/include -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libcody -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libdecnumber -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libdecnumber/bid -I ../libdecnumber -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libbacktrace -internal-isystem /usr/bin/../lib64/gcc/x86_64-suse-linux/13/../../../../include/c++/13 -internal-isystem /usr/bin/../lib64/gcc/x86_64-suse-linux/13/../../../../include/c++/13/x86_64-suse-linux -internal-isystem /usr/bin/../lib64/gcc/x86_64-suse-linux/13/../../../../include/c++/13/backward -internal-isystem /usr/lib64/clang/15.0.7/include -internal-isystem /usr/local/include -internal-isystem /usr/bin/../lib64/gcc/x86_64-suse-linux/13/../../../../x86_64-suse-linux/include -internal-externc-isystem /include -internal-externc-isystem /usr/include -O2 -Wno-narrowing -Wwrite-strings -Wno-long-long -Wno-variadic-macros -Wno-overlength-strings -fdeprecated-macro -fdebug-compilation-dir=/buildworker/marxinbox-gcc-clang-static-analyzer/objdir/gcc -ferror-limit 19 -fno-rtti -fgnuc-version=4.2.1 -vectorize-loops -vectorize-slp -analyzer-output=plist-html -analyzer-config silence-checkers=core.NullDereference -faddrsig -D__GCC_HAVE_DWARF2_CFI_ASM=1 -o /buildworker/marxinbox-gcc-clang-static-analyzer/objdir/clang-static-analyzer/2023-03-27-141847-20772-1/report-cSVz1P.plist -x c++ /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/error.cc
1/* Handle errors.
2 Copyright (C) 2000-2023 Free Software Foundation, Inc.
3 Contributed by Andy Vaught & Niels Kristian Bech Jensen
4
5This file is part of GCC.
6
7GCC is free software; you can redistribute it and/or modify it under
8the terms of the GNU General Public License as published by the Free
9Software Foundation; either version 3, or (at your option) any later
10version.
11
12GCC is distributed in the hope that it will be useful, but WITHOUT ANY
13WARRANTY; without even the implied warranty of MERCHANTABILITY or
14FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
15for more details.
16
17You should have received a copy of the GNU General Public License
18along 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
37static int suppress_errors = 0;
38
39static bool warnings_not_errors = false;
40
41static int terminal_width;
42
43/* True if the error/warnings should be buffered. */
44static bool buffered_p;
45
46static gfc_error_buffer error_buffer;
47/* These are always buffered buffers (.flush_p == false) to be used by
48 the pretty-printer. */
49static output_buffer *pp_error_buffer, *pp_warning_buffer;
50static int warningcount_buffered, werrorcount_buffered;
51
52/* Return buffered_p. */
53bool
54gfc_buffered_p (void)
55{
56 return buffered_p;
57}
58
59/* Return true if there output_buffer is empty. */
60
61static bool
62gfc_output_buffer_empty_p (const output_buffer * buf)
63{
64 return output_buffer_last_position_in_text (buf) == NULL__null;
65}
66
67/* Go one level deeper suppressing errors. */
68
69void
70gfc_push_suppress_errors (void)
71{
72 gcc_assert (suppress_errors >= 0)((void)(!(suppress_errors >= 0) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/error.cc"
, 72, __FUNCTION__), 0 : 0));
73 ++suppress_errors;
74}
75
76static void
77gfc_error_opt (int opt, const char *gmsgid, va_list ap) ATTRIBUTE_GCC_GFC(2,0)__attribute__ ((__format__ (__gcc_gfc__, 2, 0))) __attribute__
((__nonnull__ (2)));
78
79static bool
80gfc_warning (int opt, const char *gmsgid, va_list ap) ATTRIBUTE_GCC_GFC(2,0)__attribute__ ((__format__ (__gcc_gfc__, 2, 0))) __attribute__
((__nonnull__ (2)));
81
82
83/* Leave one level of error suppressing. */
84
85void
86gfc_pop_suppress_errors (void)
87{
88 gcc_assert (suppress_errors > 0)((void)(!(suppress_errors > 0) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/error.cc"
, 88, __FUNCTION__), 0 : 0));
89 --suppress_errors;
90}
91
92
93/* Query whether errors are suppressed. */
94
95bool
96gfc_query_suppress_errors (void)
97{
98 return suppress_errors > 0;
99}
100
101
102/* Determine terminal width (for trimming source lines in output). */
103
104static int
105gfc_get_terminal_width (void)
106{
107 return isatty (STDERR_FILENO2) ? get_terminal_width () : INT_MAX2147483647;
108}
109
110
111/* Per-file error initialization. */
112
113void
114gfc_error_init_1 (void)
115{
116 terminal_width = gfc_get_terminal_width ();
117 gfc_buffer_error (false);
118}
119
120
121/* Set the flag for buffering errors or not. */
122
123void
124gfc_buffer_error (bool flag)
125{
126 buffered_p = flag;
127}
128
129
130/* Add a single character to the error buffer or output depending on
131 buffered_p. */
132
133static void
134error_char (char)
135{
136 /* FIXME: Unused function to be removed in a subsequent patch. */
137}
138
139
140/* Copy a string to wherever it needs to go. */
141
142static void
143error_string (const char *p)
144{
145 while (*p)
146 error_char (*p++);
147}
148
149
150/* Print a formatted integer to the error buffer or output. */
151
152#define IBUF_LEN60 60
153
154static void
155error_uinteger (unsigned long long int i)
156{
157 char *p, int_buf[IBUF_LEN60];
158
159 p = int_buf + IBUF_LEN60 - 1;
160 *p-- = '\0';
161
162 if (i == 0)
163 *p-- = '0';
164
165 while (i > 0)
166 {
167 *p-- = i % 10 + '0';
168 i = i / 10;
169 }
170
171 error_string (p + 1);
172}
173
174static void
175error_integer (long long int i)
176{
177 unsigned long long int u;
178
179 if (i < 0)
180 {
181 u = (unsigned long long int) -i;
182 error_char ('-');
183 }
184 else
185 u = i;
186
187 error_uinteger (u);
188}
189
190
191static void
192error_hwuint (unsigned HOST_WIDE_INTlong i)
193{
194 char *p, int_buf[IBUF_LEN60];
195
196 p = int_buf + IBUF_LEN60 - 1;
197 *p-- = '\0';
198
199 if (i == 0)
200 *p-- = '0';
201
202 while (i > 0)
203 {
204 *p-- = i % 10 + '0';
205 i = i / 10;
206 }
207
208 error_string (p + 1);
209}
210
211static void
212error_hwint (HOST_WIDE_INTlong i)
213{
214 unsigned HOST_WIDE_INTlong u;
215
216 if (i < 0)
217 {
218 u = (unsigned HOST_WIDE_INTlong) -i;
219 error_char ('-');
220 }
221 else
222 u = i;
223
224 error_uinteger (u);
225}
226
227
228static size_t
229gfc_widechar_display_length (gfc_char_t c)
230{
231 if (gfc_wide_is_printable (c) || c == '\t')
232 /* Printable ASCII character, or tabulation (output as a space). */
233 return 1;
234 else if (c < ((gfc_char_t) 1 << 8))
235 /* Displayed as \x?? */
236 return 4;
237 else if (c < ((gfc_char_t) 1 << 16))
238 /* Displayed as \u???? */
239 return 6;
240 else
241 /* Displayed as \U???????? */
242 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
249static size_t
250gfc_wide_display_length (const gfc_char_t *str)
251{
252 size_t i, len;
253
254 for (i = 0, len = 0; str[i]; i++)
255 len += gfc_widechar_display_length (str[i]);
256
257 return len;
258}
259
260static int
261print_wide_char_into_buffer (gfc_char_t c, char *buf)
262{
263 static const char xdigit[16] = { '0', '1', '2', '3', '4', '5', '6',
264 '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F' };
265
266 if (gfc_wide_is_printable (c) || c == '\t')
267 {
268 buf[1] = '\0';
269 /* Tabulation is output as a space. */
270 buf[0] = (unsigned char) (c == '\t' ? ' ' : c);
271 return 1;
272 }
273 else if (c < ((gfc_char_t) 1 << 8))
274 {
275 buf[4] = '\0';
276 buf[3] = xdigit[c & 0x0F];
277 c = c >> 4;
278 buf[2] = xdigit[c & 0x0F];
279
280 buf[1] = 'x';
281 buf[0] = '\\';
282 return 4;
283 }
284 else if (c < ((gfc_char_t) 1 << 16))
285 {
286 buf[6] = '\0';
287 buf[5] = xdigit[c & 0x0F];
288 c = c >> 4;
289 buf[4] = xdigit[c & 0x0F];
290 c = c >> 4;
291 buf[3] = xdigit[c & 0x0F];
292 c = c >> 4;
293 buf[2] = xdigit[c & 0x0F];
294
295 buf[1] = 'u';
296 buf[0] = '\\';
297 return 6;
298 }
299 else
300 {
301 buf[10] = '\0';
302 buf[9] = xdigit[c & 0x0F];
303 c = c >> 4;
304 buf[8] = xdigit[c & 0x0F];
305 c = c >> 4;
306 buf[7] = xdigit[c & 0x0F];
307 c = c >> 4;
308 buf[6] = xdigit[c & 0x0F];
309 c = c >> 4;
310 buf[5] = xdigit[c & 0x0F];
311 c = c >> 4;
312 buf[4] = xdigit[c & 0x0F];
313 c = c >> 4;
314 buf[3] = xdigit[c & 0x0F];
315 c = c >> 4;
316 buf[2] = xdigit[c & 0x0F];
317
318 buf[1] = 'U';
319 buf[0] = '\\';
320 return 10;
321 }
322}
323
324static char wide_char_print_buffer[11];
325
326const char *
327gfc_print_wide_char (gfc_char_t c)
328{
329 print_wide_char_into_buffer (c, wide_char_print_buffer);
330 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
338static void error_printf (const char *, ...) ATTRIBUTE_GCC_GFC(1,2)__attribute__ ((__format__ (__gcc_gfc__, 1, 2))) __attribute__
((__nonnull__ (1)));
339
340static void
341show_locus (locus *loc, int c1, int c2)
342{
343 gfc_linebuf *lb;
344 gfc_file *f;
345 gfc_char_t *p;
346 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 lb = loc->lb;
359 f = lb->file;
360
361 error_string (f->filename);
362 error_char (':');
363
364 error_integer (LOCATION_LINE (lb->location)((expand_location (lb->location)).line));
365
366 if ((c1 > 0) || (c2 > 0))
367 error_char ('.');
368
369 if (c1 > 0)
370 error_integer (c1);
371
372 if ((c1 > 0) && (c2 > 0))
373 error_char ('-');
374
375 if (c2 > 0)
376 error_integer (c2);
377
378 error_char (':');
379 error_char ('\n');
380
381 for (;;)
382 {
383 i = f->inclusion_line;
384
385 f = f->up;
386 if (f == NULL__null) break;
387
388 error_printf (" Included at %s:%d:", f->filename, i);
389 }
390
391 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 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 if (c1 == c2)
406 c2 += 1;
407
408 cmax = (c1 < c2) ? c2 : c1;
409 if (cmax > terminal_width - 5)
410 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 p = &(lb->line[offset]);
417 i = gfc_wide_display_length (p);
418 if (i > terminal_width)
419 i = terminal_width - 1;
420
421 while (i > 0)
422 {
423 static char buffer[11];
424 i -= print_wide_char_into_buffer (*p++, buffer);
425 error_string (buffer);
426 }
427
428 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 c1 -= offset;
435 c2 -= offset;
436 cmax -= offset;
437
438 p = &(lb->line[offset]);
439 for (i = 0; i < cmax; i++)
440 {
441 int spaces, j;
442 spaces = gfc_widechar_display_length (*p++);
443
444 if (i == c1)
445 error_char ('1'), spaces--;
446 else if (i == c2)
447 error_char ('2'), spaces--;
448
449 for (j = 0; j < spaces; j++)
450 error_char (' ');
451 }
452
453 if (i == c1)
454 error_char ('1');
455 else if (i == c2)
456 error_char ('2');
457
458 error_char ('\n');
459
460}
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
467static void
468show_loci (locus *l1, locus *l2)
469{
470 int m, c1, c2;
471
472 if (l1 == NULL__null || l1->lb == NULL__null)
473 {
474 error_printf ("<During initialization>\n");
475 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 c1 = l1->nextc - l1->lb->line;
483 if (l2 == NULL__null)
484 {
485 show_locus (l1, c1, -1);
486 return;
487 }
488
489 c2 = l2->nextc - l2->lb->line;
490
491 if (c1 < c2)
492 m = c2 - c1;
493 else
494 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 if (l1->lb != l2->lb || m > terminal_width - 10)
500 {
501 show_locus (l1, c1, -1);
502 show_locus (l2, -1, c2);
503 return;
504 }
505
506 show_locus (l1, c1, c2);
507
508 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_ARGS10 10
533
534static void ATTRIBUTE_GCC_GFC(2,0)__attribute__ ((__format__ (__gcc_gfc__, 2, 0))) __attribute__
((__nonnull__ (2)))
535error_print (const char *type, const char *format0, va_list argp)
536{
537 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 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_INTlong hwintval;
553 unsigned HOST_WIDE_INTlong hwuintval;
554 char charval;
555 const char * stringval;
556 } u;
557 } arg[MAX_ARGS10], spec[MAX_ARGS10];
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 char c;
563 int i, n, have_l1, pos, maxpos;
564 locus *l1, *l2, *loc;
565 const char *format;
566
567 loc = l1 = l2 = NULL__null;
568
569 have_l1 = 0;
570 pos = -1;
571 maxpos = -1;
572
573 n = 0;
574 format = format0;
575
576 for (i = 0; i < MAX_ARGS10; i++)
577 {
578 arg[i].type = NOTYPE;
579 spec[i].pos = -1;
580 }
581
582 /* First parse the format string for position specifiers. */
583 while (*format)
584 {
585 c = *format++;
586 if (c != '%')
587 continue;
588
589 if (*format == '%')
590 {
591 format++;
592 continue;
593 }
594
595 if (ISDIGIT (*format)(_sch_istable[(*format) & 0xff] & (unsigned short)(_sch_isdigit
)))
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 pos = atoi(format) - 1;
602 gcc_assert (pos >= 0)((void)(!(pos >= 0) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/error.cc"
, 602, __FUNCTION__), 0 : 0));
603 while (ISDIGIT(*format)(_sch_istable[(*format) & 0xff] & (unsigned short)(_sch_isdigit
)))
604 format++;
605 gcc_assert (*format == '$')((void)(!(*format == '$') ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/error.cc"
, 605, __FUNCTION__), 0 : 0));
606 format++;
607 }
608 else
609 pos++;
610
611 c = *format++;
612
613 if (pos > maxpos)
614 maxpos = pos;
615
616 switch (c)
617 {
618 case 'C':
619 arg[pos].type = TYPE_CURRENTLOC;
620 break;
621
622 case 'L':
623 arg[pos].type = TYPE_LOCUS;
624 break;
625
626 case 'd':
627 case 'i':
628 arg[pos].type = TYPE_INTEGER;
629 break;
630
631 case 'u':
632 arg[pos].type = TYPE_UINTEGER;
633 break;
634
635 case 'l':
636 c = *format++;
637 if (c == 'l')
638 {
639 c = *format++;
640 if (c == 'u')
641 arg[pos].type = TYPE_ULLONGINT;
642 else if (c == 'i' || c == 'd')
643 arg[pos].type = TYPE_LLONGINT;
644 else
645 gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/error.cc"
, 645, __FUNCTION__));
646 }
647 else if (c == 'u')
648 arg[pos].type = TYPE_ULONGINT;
649 else if (c == 'i' || c == 'd')
650 arg[pos].type = TYPE_LONGINT;
651 else
652 gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/error.cc"
, 652, __FUNCTION__));
653 break;
654
655 case 'w':
656 c = *format++;
657 if (c == 'u')
658 arg[pos].type = TYPE_HWUINT;
659 else if (c == 'i' || c == 'd')
660 arg[pos].type = TYPE_HWINT;
661 else
662 gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/error.cc"
, 662, __FUNCTION__));
663 break;
664
665 case 'c':
666 arg[pos].type = TYPE_CHAR;
667 break;
668
669 case 's':
670 arg[pos].type = TYPE_STRING;
671 break;
672
673 default:
674 gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/error.cc"
, 674, __FUNCTION__));
675 }
676
677 spec[n++].pos = pos;
678 }
679
680 /* Then convert the values for each %-style argument. */
681 for (pos = 0; pos <= maxpos; pos++)
682 {
683 gcc_assert (arg[pos].type != NOTYPE)((void)(!(arg[pos].type != NOTYPE) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/error.cc"
, 683, __FUNCTION__), 0 : 0));
684 switch (arg[pos].type)
685 {
686 case TYPE_CURRENTLOC:
687 loc = &gfc_current_locus;
688 /* Fall through. */
689
690 case TYPE_LOCUS:
691 if (arg[pos].type == TYPE_LOCUS)
692 loc = va_arg (argp, locus *)__builtin_va_arg(argp, locus *);
693
694 if (have_l1)
695 {
696 l2 = loc;
697 arg[pos].u.stringval = "(2)";
698 /* Point %C first offending character not the last good one. */
699 if (arg[pos].type == TYPE_CURRENTLOC && *l2->nextc != '\0')
700 l2->nextc++;
701 }
702 else
703 {
704 l1 = loc;
705 have_l1 = 1;
706 arg[pos].u.stringval = "(1)";
707 /* Point %C first offending character not the last good one. */
708 if (arg[pos].type == TYPE_CURRENTLOC && *l1->nextc != '\0')
709 l1->nextc++;
710 }
711 break;
712
713 case TYPE_INTEGER:
714 arg[pos].u.intval = va_arg (argp, int)__builtin_va_arg(argp, int);
715 break;
716
717 case TYPE_UINTEGER:
718 arg[pos].u.uintval = va_arg (argp, unsigned int)__builtin_va_arg(argp, unsigned int);
719 break;
720
721 case TYPE_LONGINT:
722 arg[pos].u.longintval = va_arg (argp, long int)__builtin_va_arg(argp, long int);
723 break;
724
725 case TYPE_ULONGINT:
726 arg[pos].u.ulongintval = va_arg (argp, unsigned long int)__builtin_va_arg(argp, unsigned long int);
727 break;
728
729 case TYPE_LLONGINT:
730 arg[pos].u.llongintval = va_arg (argp, long long int)__builtin_va_arg(argp, long long int);
731 break;
732
733 case TYPE_ULLONGINT:
734 arg[pos].u.ullongintval = va_arg (argp, unsigned long long int)__builtin_va_arg(argp, unsigned long long int);
735 break;
736
737 case TYPE_HWINT:
738 arg[pos].u.hwintval = va_arg (argp, HOST_WIDE_INT)__builtin_va_arg(argp, long);
739 break;
740
741 case TYPE_HWUINT:
742 arg[pos].u.hwuintval = va_arg (argp, unsigned HOST_WIDE_INT)__builtin_va_arg(argp, unsigned long);
743 break;
744
745 case TYPE_CHAR:
746 arg[pos].u.charval = (char) va_arg (argp, int)__builtin_va_arg(argp, int);
747 break;
748
749 case TYPE_STRING:
750 arg[pos].u.stringval = (const char *) va_arg (argp, char *)__builtin_va_arg(argp, char *);
751 break;
752
753 default:
754 gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/error.cc"
, 754, __FUNCTION__));
755 }
756 }
757
758 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 if (have_l1)
763 show_loci (l1, l2);
764
765 if (*type)
766 {
767 error_string (type);
768 error_char (' ');
769 }
770
771 have_l1 = 0;
Value stored to 'have_l1' is never read
772 format = format0;
773 n = 0;
774
775 for (; *format; format++)
776 {
777 if (*format != '%')
778 {
779 error_char (*format);
780 continue;
781 }
782
783 format++;
784 if (ISDIGIT (*format)(_sch_istable[(*format) & 0xff] & (unsigned short)(_sch_isdigit
)))
785 {
786 /* This is a position specifier. See comment above. */
787 while (ISDIGIT (*format)(_sch_istable[(*format) & 0xff] & (unsigned short)(_sch_isdigit
)))
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 error_char ('\n');
846}
847
848
849/* Wrapper for error_print(). */
850
851static void
852error_printf (const char *gmsgid, ...)
853{
854 va_list argp;
855
856 va_start (argp, gmsgid)__builtin_va_start(argp, gmsgid);
857 error_print ("", _(gmsgid)gettext (gmsgid), argp);
858 va_end (argp)__builtin_va_end(argp);
859}
860
861
862/* Clear any output buffered in a pretty-print output_buffer. */
863
864static void
865gfc_clear_pp_buffer (output_buffer *this_buffer)
866{
867 pretty_printer *pp = global_dc->printer;
868 output_buffer *tmp_buffer = pp->buffer;
869 pp->buffer = this_buffer;
870 pp_clear_output_area (pp);
871 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 global_dc->last_location = UNKNOWN_LOCATION((location_t) 0);
875}
876
877/* The currently-printing diagnostic, for use by gfc_format_decoder,
878 for colorizing %C and %L. */
879
880static 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
885static bool
886gfc_report_diagnostic (diagnostic_info *diagnostic)
887{
888 gcc_assert (diagnostic != NULL)((void)(!(diagnostic != __null) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/error.cc"
, 888, __FUNCTION__), 0 : 0));
889 curr_diagnostic = diagnostic;
890 bool ret = diagnostic_report_diagnostic (global_dc, diagnostic);
891 curr_diagnostic = NULL__null;
892 return ret;
893}
894
895/* This is just a helper function to avoid duplicating the logic of
896 gfc_warning. */
897
898static bool
899gfc_warning (int opt, const char *gmsgid, va_list ap)
900{
901 va_list argp;
902 va_copy (argp, ap)__builtin_va_copy(argp, ap);
903
904 diagnostic_info diagnostic;
905 rich_location rich_loc (line_table, UNKNOWN_LOCATION((location_t) 0));
906 bool fatal_errors = global_dc->fatal_errors;
907 pretty_printer *pp = global_dc->printer;
908 output_buffer *tmp_buffer = pp->buffer;
909
910 gfc_clear_pp_buffer (pp_warning_buffer);
911
912 if (buffered_p)
913 {
914 pp->buffer = pp_warning_buffer;
915 global_dc->fatal_errors = false;
916 /* To prevent -fmax-errors= triggering. */
917 --werrorcount(global_dc)->diagnostic_count[(int) (DK_WERROR)];
918 }
919
920 diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc,
921 DK_WARNING);
922 diagnostic.option_index = opt;
923 bool ret = gfc_report_diagnostic (&diagnostic);
924
925 if (buffered_p)
926 {
927 pp->buffer = tmp_buffer;
928 global_dc->fatal_errors = fatal_errors;
929
930 warningcount_buffered = 0;
931 werrorcount_buffered = 0;
932 /* Undo the above --werrorcount if not Werror, otherwise
933 werrorcount is correct already. */
934 if (!ret)
935 ++werrorcount(global_dc)->diagnostic_count[(int) (DK_WERROR)];
936 else if (diagnostic.kind == DK_ERROR)
937 ++werrorcount_buffered;
938 else
939 ++werrorcount(global_dc)->diagnostic_count[(int) (DK_WERROR)], --warningcount(global_dc)->diagnostic_count[(int) (DK_WARNING)], ++warningcount_buffered;
940 }
941
942 va_end (argp)__builtin_va_end(argp);
943 return ret;
944}
945
946/* Issue a warning. */
947
948bool
949gfc_warning (int opt, const char *gmsgid, ...)
950{
951 va_list argp;
952
953 va_start (argp, gmsgid)__builtin_va_start(argp, gmsgid);
954 bool ret = gfc_warning (opt, gmsgid, argp);
955 va_end (argp)__builtin_va_end(argp);
956 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
963notification
964gfc_notification_std (int std)
965{
966 bool warning;
967
968 warning = ((gfc_option.warn_std & std) != 0) && !inhibit_warningsglobal_options.x_inhibit_warnings;
969 if ((gfc_option.allow_std & std) != 0 && !warning)
970 return SILENT;
971
972 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
979char const*
980notify_std_msg(int std)
981{
982
983 if (std & GFC_STD_F2018_DEL(1<<11))
984 return _("Fortran 2018 deleted feature:")gettext ("Fortran 2018 deleted feature:");
985 else if (std & GFC_STD_F2018_OBS(1<<10))
986 return _("Fortran 2018 obsolescent feature:")gettext ("Fortran 2018 obsolescent feature:");
987 else if (std & GFC_STD_F2018(1<<9))
988 return _("Fortran 2018:")gettext ("Fortran 2018:");
989 else if (std & GFC_STD_F2008_OBS(1<<8))
990 return _("Fortran 2008 obsolescent feature:")gettext ("Fortran 2008 obsolescent feature:");
991 else if (std & GFC_STD_F2008(1<<7))
992 return "Fortran 2008:";
993 else if (std & GFC_STD_F2003(1<<4))
994 return "Fortran 2003:";
995 else if (std & GFC_STD_GNU(1<<5))
996 return _("GNU Extension:")gettext ("GNU Extension:");
997 else if (std & GFC_STD_LEGACY(1<<6))
998 return _("Legacy Extension:")gettext ("Legacy Extension:");
999 else if (std & GFC_STD_F95_OBS(1<<1))
1000 return _("Obsolescent feature:")gettext ("Obsolescent feature:");
1001 else if (std & GFC_STD_F95_DEL(1<<2))
1002 return _("Deleted feature:")gettext ("Deleted feature:");
1003 else
1004 gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/error.cc"
, 1004, __FUNCTION__));
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
1013bool
1014gfc_notify_std (int std, const char *gmsgid, ...)
1015{
1016 va_list argp;
1017 const char *msg, *msg2;
1018 char *buffer;
1019
1020 /* Determine whether an error or a warning is needed. */
1021 const int wstd = std & gfc_option.warn_std; /* Standard to warn about. */
1022 const int estd = std & ~gfc_option.allow_std; /* Standard to error about. */
1023 const bool warning = (wstd != 0) && !inhibit_warningsglobal_options.x_inhibit_warnings;
1024 const bool error = (estd != 0);
1025
1026 if (!error && !warning)
1027 return true;
1028 if (suppress_errors)
1029 return !error;
1030
1031 if (error)
1032 msg = notify_std_msg (estd);
1033 else
1034 msg = notify_std_msg (wstd);
1035
1036 msg2 = _(gmsgid)gettext (gmsgid);
1037 buffer = (char *) alloca (strlen (msg) + strlen (msg2) + 2)__builtin_alloca(strlen (msg) + strlen (msg2) + 2);
1038 strcpy (buffer, msg);
1039 strcat (buffer, " ");
1040 strcat (buffer, msg2);
1041
1042 va_start (argp, gmsgid)__builtin_va_start(argp, gmsgid);
1043 if (error)
1044 gfc_error_opt (0, buffer, argp);
1045 else
1046 gfc_warning (0, buffer, argp);
1047 va_end (argp)__builtin_va_end(argp);
1048
1049 if (error)
1050 return false;
1051 else
1052 return (warning && !warnings_are_errorsglobal_options.x_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*/
1062static bool
1063gfc_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 switch (*spec)
1068 {
1069 case 'C':
1070 case 'L':
1071 {
1072 static const char *result[2] = { "(1)", "(2)" };
1073 locus *loc;
1074 if (*spec == 'C')
1075 loc = &gfc_current_locus;
1076 else
1077 loc = va_arg (*text->args_ptr, locus *)__builtin_va_arg(*text->args_ptr, locus *);
1078 gcc_assert (loc->nextc - loc->lb->line >= 0)((void)(!(loc->nextc - loc->lb->line >= 0) ? fancy_abort
("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/error.cc"
, 1078, __FUNCTION__), 0 : 0));
1079 unsigned int offset = loc->nextc - loc->lb->line;
1080 if (*spec == 'C' && *loc->nextc != '\0')
1081 /* Point %C first offending character not the last good one. */
1082 offset++;
1083 /* If location[0] != UNKNOWN_LOCATION means that we already
1084 processed one of %C/%L. */
1085 int loc_num = text->get_location (0) == UNKNOWN_LOCATION((location_t) 0) ? 0 : 1;
1086 location_t src_loc
1087 = linemap_position_for_loc_and_offset (line_table,
1088 loc->lb->location,
1089 offset);
1090 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 gcc_assert (curr_diagnostic != NULL)((void)(!(curr_diagnostic != __null) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/error.cc"
, 1095, __FUNCTION__), 0 : 0));
1096 const char *color
1097 = (loc_num
1098 ? "range1"
1099 : diagnostic_get_color_for_kind (curr_diagnostic->kind));
1100 pp_string (pp, colorize_start (pp_show_color (pp)(pp)->show_color, color));
1101 pp_string (pp, result[loc_num]);
1102 pp_string (pp, colorize_stop (pp_show_color (pp)(pp)->show_color));
1103 return true;
1104 }
1105 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 return default_tree_printer (pp, text, spec, precision, wide,
1110 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. */
1116static char *
1117gfc_diagnostic_build_kind_prefix (diagnostic_context *context,
1118 const diagnostic_info *diagnostic)
1119{
1120 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 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__null
1131 };
1132 gcc_assert (diagnostic->kind < DK_LAST_DIAGNOSTIC_KIND)((void)(!(diagnostic->kind < DK_LAST_DIAGNOSTIC_KIND) ?
fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/error.cc"
, 1132, __FUNCTION__), 0 : 0));
1133 const char *text = _(diagnostic_kind_text[diagnostic->kind])gettext (diagnostic_kind_text[diagnostic->kind]);
1134 const char *text_cs = "", *text_ce = "";
1135 pretty_printer *pp = context->printer;
1136
1137 if (diagnostic_kind_color[diagnostic->kind])
1138 {
1139 text_cs = colorize_start (pp_show_color (pp)(pp)->show_color,
1140 diagnostic_kind_color[diagnostic->kind]);
1141 text_ce = colorize_stop (pp_show_color (pp)(pp)->show_color);
1142 }
1143 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. */
1148static char *
1149gfc_diagnostic_build_locus_prefix (diagnostic_context *context,
1150 expanded_location s)
1151{
1152 pretty_printer *pp = context->printer;
1153 const char *locus_cs = colorize_start (pp_show_color (pp)(pp)->show_color, "locus");
1154 const char *locus_ce = colorize_stop (pp_show_color (pp)(pp)->show_color);
1155 return (s.file == NULL__null
1156 ? build_message_string ("%s%s:%s", locus_cs, progname, locus_ce )
1157 : !strcmp (s.file, special_fname_builtin ())
1158 ? build_message_string ("%s%s:%s", locus_cs, s.file, locus_ce)
1159 : context->show_column
1160 ? build_message_string ("%s%s:%d:%d:%s", locus_cs, s.file, s.line,
1161 s.column, locus_ce)
1162 : 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. */
1167static char *
1168gfc_diagnostic_build_locus_prefix (diagnostic_context *context,
1169 expanded_location s, expanded_location s2)
1170{
1171 pretty_printer *pp = context->printer;
1172 const char *locus_cs = colorize_start (pp_show_color (pp)(pp)->show_color, "locus");
1173 const char *locus_ce = colorize_stop (pp_show_color (pp)(pp)->show_color);
1174
1175 return (s.file == NULL__null
1176 ? build_message_string ("%s%s:%s", locus_cs, progname, locus_ce )
1177 : !strcmp (s.file, special_fname_builtin ())
1178 ? build_message_string ("%s%s:%s", locus_cs, s.file, locus_ce)
1179 : context->show_column
1180 ? build_message_string ("%s%s:%d:%d-%d:%s", locus_cs, s.file, s.line,
1181 MIN (s.column, s2.column)((s.column) < (s2.column) ? (s.column) : (s2.column)),
1182 MAX (s.column, s2.column)((s.column) > (s2.column) ? (s.column) : (s2.column)), locus_ce)
1183 : build_message_string ("%s%s:%d:%s", locus_cs, s.file, s.line,
1184 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*/
1204static void
1205gfc_diagnostic_starter (diagnostic_context *context,
1206 diagnostic_info *diagnostic)
1207{
1208 char * kind_prefix = gfc_diagnostic_build_kind_prefix (context, diagnostic);
1209
1210 expanded_location s1 = diagnostic_expand_location (diagnostic);
1211 expanded_location s2;
1212 bool one_locus = diagnostic->richloc->get_num_locations () < 2;
1213 bool same_locus = false;
1214
1215 if (!one_locus)
1216 {
1217 s2 = diagnostic_expand_location (diagnostic, 1);
1218 same_locus = diagnostic_same_line (context, s1, s2);
1219 }
1220
1221 char * locus_prefix = (one_locus || !same_locus)
1222 ? gfc_diagnostic_build_locus_prefix (context, s1)
1223 : gfc_diagnostic_build_locus_prefix (context, s1, s2);
1224
1225 if (!context->show_caret
1226 || diagnostic_location (diagnostic, 0) <= BUILTINS_LOCATION((location_t) 1)
1227 || diagnostic_location (diagnostic, 0) == context->last_location)
1228 {
1229 pp_set_prefix (context->printer,
1230 concat (locus_prefix, " ", kind_prefix, NULL__null));
1231 free (locus_prefix);
1232
1233 if (one_locus || same_locus)
1234 {
1235 free (kind_prefix);
1236 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 pp_string (context->printer, "(1)");
1244 pp_newline (context->printer);
1245 locus_prefix = gfc_diagnostic_build_locus_prefix (context, s2);
1246 pp_set_prefix (context->printer,
1247 concat (locus_prefix, " ", kind_prefix, NULL__null));
1248 free (kind_prefix);
1249 free (locus_prefix);
1250 }
1251 else
1252 {
1253 pp_verbatim (context->printer, "%s", locus_prefix);
1254 free (locus_prefix);
1255 /* Fortran uses an empty line between locus and caret line. */
1256 pp_newline (context->printer);
1257 pp_set_prefix (context->printer, NULL__null);
1258 pp_newline (context->printer);
1259 diagnostic_show_locus (context, diagnostic->richloc, diagnostic->kind);
1260 /* If the caret line was shown, the prefix does not contain the
1261 locus. */
1262 pp_set_prefix (context->printer, kind_prefix);
1263 }
1264}
1265
1266static void
1267gfc_diagnostic_start_span (diagnostic_context *context,
1268 expanded_location exploc)
1269{
1270 char *locus_prefix;
1271 locus_prefix = gfc_diagnostic_build_locus_prefix (context, exploc);
1272 pp_verbatim (context->printer, "%s", locus_prefix);
1273 free (locus_prefix);
1274 pp_newline (context->printer);
1275 /* Fortran uses an empty line between locus and caret line. */
1276 pp_newline (context->printer);
1277}
1278
1279
1280static void
1281gfc_diagnostic_finalizer (diagnostic_context *context,
1282 diagnostic_info *diagnostic ATTRIBUTE_UNUSED__attribute__ ((__unused__)),
1283 diagnostic_t orig_diag_kind ATTRIBUTE_UNUSED__attribute__ ((__unused__)))
1284{
1285 pp_destroy_prefix (context->printer);
1286 pp_newline_and_flush (context->printer);
1287}
1288
1289/* Immediate warning (i.e. do not buffer the warning) with an explicit
1290 location. */
1291
1292bool
1293gfc_warning_now_at (location_t loc, int opt, const char *gmsgid, ...)
1294{
1295 va_list argp;
1296 diagnostic_info diagnostic;
1297 rich_location rich_loc (line_table, loc);
1298 bool ret;
1299
1300 va_start (argp, gmsgid)__builtin_va_start(argp, gmsgid);
1301 diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc, DK_WARNING);
1302 diagnostic.option_index = opt;
1303 ret = gfc_report_diagnostic (&diagnostic);
1304 va_end (argp)__builtin_va_end(argp);
1305 return ret;
1306}
1307
1308/* Immediate warning (i.e. do not buffer the warning). */
1309
1310bool
1311gfc_warning_now (int opt, const char *gmsgid, ...)
1312{
1313 va_list argp;
1314 diagnostic_info diagnostic;
1315 rich_location rich_loc (line_table, UNKNOWN_LOCATION((location_t) 0));
1316 bool ret;
1317
1318 va_start (argp, gmsgid)__builtin_va_start(argp, gmsgid);
1319 diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc,
1320 DK_WARNING);
1321 diagnostic.option_index = opt;
1322 ret = gfc_report_diagnostic (&diagnostic);
1323 va_end (argp)__builtin_va_end(argp);
1324 return ret;
1325}
1326
1327/* Internal warning, do not buffer. */
1328
1329bool
1330gfc_warning_internal (int opt, const char *gmsgid, ...)
1331{
1332 va_list argp;
1333 diagnostic_info diagnostic;
1334 rich_location rich_loc (line_table, UNKNOWN_LOCATION((location_t) 0));
1335 bool ret;
1336
1337 va_start (argp, gmsgid)__builtin_va_start(argp, gmsgid);
1338 diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc,
1339 DK_WARNING);
1340 diagnostic.option_index = opt;
1341 ret = gfc_report_diagnostic (&diagnostic);
1342 va_end (argp)__builtin_va_end(argp);
1343 return ret;
1344}
1345
1346/* Immediate error (i.e. do not buffer). */
1347
1348void
1349gfc_error_now (const char *gmsgid, ...)
1350{
1351 va_list argp;
1352 diagnostic_info diagnostic;
1353 rich_location rich_loc (line_table, UNKNOWN_LOCATION((location_t) 0));
1354
1355 error_buffer.flag = true;
1356
1357 va_start (argp, gmsgid)__builtin_va_start(argp, gmsgid);
1358 diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc, DK_ERROR);
1359 gfc_report_diagnostic (&diagnostic);
1360 va_end (argp)__builtin_va_end(argp);
1361}
1362
1363
1364/* Fatal error, never returns. */
1365
1366void
1367gfc_fatal_error (const char *gmsgid, ...)
1368{
1369 va_list argp;
1370 diagnostic_info diagnostic;
1371 rich_location rich_loc (line_table, UNKNOWN_LOCATION((location_t) 0));
1372
1373 va_start (argp, gmsgid)__builtin_va_start(argp, gmsgid);
1374 diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc, DK_FATAL);
1375 gfc_report_diagnostic (&diagnostic);
1376 va_end (argp)__builtin_va_end(argp);
1377
1378 gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/error.cc"
, 1378, __FUNCTION__));
1379}
1380
1381/* Clear the warning flag. */
1382
1383void
1384gfc_clear_warning (void)
1385{
1386 gfc_clear_pp_buffer (pp_warning_buffer);
1387 warningcount_buffered = 0;
1388 werrorcount_buffered = 0;
1389}
1390
1391
1392/* Check to see if any warnings have been saved.
1393 If so, print the warning. */
1394
1395void
1396gfc_warning_check (void)
1397{
1398 if (! gfc_output_buffer_empty_p (pp_warning_buffer))
1399 {
1400 pretty_printer *pp = global_dc->printer;
1401 output_buffer *tmp_buffer = pp->buffer;
1402 pp->buffer = pp_warning_buffer;
1403 pp_really_flush (pp);
1404 warningcount(global_dc)->diagnostic_count[(int) (DK_WARNING)] += warningcount_buffered;
1405 werrorcount(global_dc)->diagnostic_count[(int) (DK_WERROR)] += werrorcount_buffered;
1406 gcc_assert (warningcount_buffered + werrorcount_buffered == 1)((void)(!(warningcount_buffered + werrorcount_buffered == 1) ?
fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/error.cc"
, 1406, __FUNCTION__), 0 : 0));
1407 pp->buffer = tmp_buffer;
1408 diagnostic_action_after_output (global_dc,
1409 warningcount_buffered
1410 ? DK_WARNING : DK_ERROR);
1411 diagnostic_check_max_errors (global_dc, true);
1412 }
1413}
1414
1415
1416/* Issue an error. */
1417
1418static void
1419gfc_error_opt (int opt, const char *gmsgid, va_list ap)
1420{
1421 va_list argp;
1422 va_copy (argp, ap)__builtin_va_copy(argp, ap);
1423 bool saved_abort_on_error = false;
1424
1425 if (warnings_not_errors)
1426 {
1427 gfc_warning (opt, gmsgid, argp);
1428 va_end (argp)__builtin_va_end(argp);
1429 return;
1430 }
1431
1432 if (suppress_errors)
1433 {
1434 va_end (argp)__builtin_va_end(argp);
1435 return;
1436 }
1437
1438 diagnostic_info diagnostic;
1439 rich_location richloc (line_table, UNKNOWN_LOCATION((location_t) 0));
1440 bool fatal_errors = global_dc->fatal_errors;
1441 pretty_printer *pp = global_dc->printer;
1442 output_buffer *tmp_buffer = pp->buffer;
1443
1444 gfc_clear_pp_buffer (pp_error_buffer);
1445
1446 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 saved_abort_on_error = global_dc->abort_on_error;
1451 global_dc->abort_on_error = false;
1452 pp->buffer = pp_error_buffer;
1453 global_dc->fatal_errors = false;
1454 /* To prevent -fmax-errors= triggering, we decrease it before
1455 report_diagnostic increases it. */
1456 --errorcount(global_dc)->diagnostic_count[(int) (DK_ERROR)];
1457 }
1458
1459 diagnostic_set_info (&diagnostic, gmsgid, &argp, &richloc, DK_ERROR);
1460 gfc_report_diagnostic (&diagnostic);
1461
1462 if (buffered_p)
1463 {
1464 pp->buffer = tmp_buffer;
1465 global_dc->fatal_errors = fatal_errors;
1466 global_dc->abort_on_error = saved_abort_on_error;
1467
1468 }
1469
1470 va_end (argp)__builtin_va_end(argp);
1471}
1472
1473
1474void
1475gfc_error_opt (int opt, const char *gmsgid, ...)
1476{
1477 va_list argp;
1478 va_start (argp, gmsgid)__builtin_va_start(argp, gmsgid);
1479 gfc_error_opt (opt, gmsgid, argp);
1480 va_end (argp)__builtin_va_end(argp);
1481}
1482
1483
1484void
1485gfc_error (const char *gmsgid, ...)
1486{
1487 va_list argp;
1488 va_start (argp, gmsgid)__builtin_va_start(argp, gmsgid);
1489 gfc_error_opt (0, gmsgid, argp);
1490 va_end (argp)__builtin_va_end(argp);
1491}
1492
1493
1494/* This shouldn't happen... but sometimes does. */
1495
1496void
1497gfc_internal_error (const char *gmsgid, ...)
1498{
1499 int e, w;
1500 va_list argp;
1501 diagnostic_info diagnostic;
1502 rich_location rich_loc (line_table, UNKNOWN_LOCATION((location_t) 0));
1503
1504 gfc_get_errors (&w, &e);
1505 if (e > 0)
1506 exit(EXIT_FAILURE1);
1507
1508 va_start (argp, gmsgid)__builtin_va_start(argp, gmsgid);
1509 diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc, DK_ICE);
1510 gfc_report_diagnostic (&diagnostic);
1511 va_end (argp)__builtin_va_end(argp);
1512
1513 gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/error.cc"
, 1513, __FUNCTION__));
1514}
1515
1516
1517/* Clear the error flag when we start to compile a source line. */
1518
1519void
1520gfc_clear_error (void)
1521{
1522 error_buffer.flag = false;
1523 warnings_not_errors = false;
1524 gfc_clear_pp_buffer (pp_error_buffer);
1525}
1526
1527
1528/* Tests the state of error_flag. */
1529
1530bool
1531gfc_error_flag_test (void)
1532{
1533 return error_buffer.flag
1534 || !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
1541bool
1542gfc_error_check (void)
1543{
1544 if (error_buffer.flag
1545 || ! gfc_output_buffer_empty_p (pp_error_buffer))
1546 {
1547 error_buffer.flag = false;
1548 pretty_printer *pp = global_dc->printer;
1549 output_buffer *tmp_buffer = pp->buffer;
1550 pp->buffer = pp_error_buffer;
1551 pp_really_flush (pp);
1552 ++errorcount(global_dc)->diagnostic_count[(int) (DK_ERROR)];
1553 gcc_assert (gfc_output_buffer_empty_p (pp_error_buffer))((void)(!(gfc_output_buffer_empty_p (pp_error_buffer)) ? fancy_abort
("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/error.cc"
, 1553, __FUNCTION__), 0 : 0));
1554 pp->buffer = tmp_buffer;
1555 diagnostic_action_after_output (global_dc, DK_ERROR);
1556 diagnostic_check_max_errors (global_dc, true);
1557 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
1567static void
1568gfc_move_error_buffer_from_to (gfc_error_buffer * buffer_from,
1569 gfc_error_buffer * buffer_to)
1570{
1571 output_buffer * from = &(buffer_from->buffer);
1572 output_buffer * to = &(buffer_to->buffer);
1573
1574 buffer_to->flag = buffer_from->flag;
1575 buffer_from->flag = false;
1576
1577 gfc_clear_pp_buffer (to);
1578 /* We make sure this is always buffered. */
1579 to->flush_p = false;
1580
1581 if (! gfc_output_buffer_empty_p (from))
1582 {
1583 const char *str = output_buffer_formatted_text (from);
1584 output_buffer_append_r (to, str, strlen (str));
1585 gfc_clear_pp_buffer (from);
1586 }
1587}
1588
1589/* Save the existing error state. */
1590
1591void
1592gfc_push_error (gfc_error_buffer *err)
1593{
1594 gfc_move_error_buffer_from_to (&error_buffer, err);
1595}
1596
1597
1598/* Restore a previous pushed error state. */
1599
1600void
1601gfc_pop_error (gfc_error_buffer *err)
1602{
1603 gfc_move_error_buffer_from_to (err, &error_buffer);
1604}
1605
1606
1607/* Free a pushed error state, but keep the current error state. */
1608
1609void
1610gfc_free_error (gfc_error_buffer *err)
1611{
1612 gfc_clear_pp_buffer (&(err->buffer));
1613}
1614
1615
1616/* Report the number of warnings and errors that occurred to the caller. */
1617
1618void
1619gfc_get_errors (int *w, int *e)
1620{
1621 if (w != NULL__null)
1622 *w = warningcount(global_dc)->diagnostic_count[(int) (DK_WARNING)] + werrorcount(global_dc)->diagnostic_count[(int) (DK_WERROR)];
1623 if (e != NULL__null)
1624 *e = errorcount(global_dc)->diagnostic_count[(int) (DK_ERROR)] + sorrycount(global_dc)->diagnostic_count[(int) (DK_SORRY)] + werrorcount(global_dc)->diagnostic_count[(int) (DK_WERROR)];
1625}
1626
1627
1628/* Switch errors into warnings. */
1629
1630void
1631gfc_errors_to_warnings (bool f)
1632{
1633 warnings_not_errors = f;
1634}
1635
1636void
1637gfc_diagnostics_init (void)
1638{
1639 diagnostic_starter (global_dc)(global_dc)->begin_diagnostic = gfc_diagnostic_starter;
1640 global_dc->start_span = gfc_diagnostic_start_span;
1641 diagnostic_finalizer (global_dc)(global_dc)->end_diagnostic = gfc_diagnostic_finalizer;
1642 diagnostic_format_decoder (global_dc)((global_dc)->printer->format_decoder) = gfc_format_decoder;
1643 global_dc->caret_chars[0] = '1';
1644 global_dc->caret_chars[1] = '2';
1645 pp_warning_buffer = new (XNEW (output_buffer)((output_buffer *) xmalloc (sizeof (output_buffer)))) output_buffer ();
1646 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 pp_error_buffer = &(error_buffer.buffer);
1650 pp_error_buffer->flush_p = false;
1651}
1652
1653void
1654gfc_diagnostics_finish (void)
1655{
1656 tree_diagnostics_defaults (global_dc);
1657 /* We still want to use the gfc starter and finalizer, not the tree
1658 defaults. */
1659 diagnostic_starter (global_dc)(global_dc)->begin_diagnostic = gfc_diagnostic_starter;
1660 diagnostic_finalizer (global_dc)(global_dc)->end_diagnostic = gfc_diagnostic_finalizer;
1661 global_dc->caret_chars[0] = '^';
1662 global_dc->caret_chars[1] = '^';
1663}