2 Copyright (C) 2000-2024 Free Software Foundation, Inc.
3 Contributed by Andy Vaught & Niels Kristian Bech Jensen
5 This file is part of GCC.
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
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
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/>. */
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. */
29 #include "coretypes.h"
33 #include "diagnostic.h"
34 #include "diagnostic-color.h"
35 #include "tree-diagnostic.h" /* tree_diagnostics_defaults */
37 static int suppress_errors
= 0;
39 static bool warnings_not_errors
= false;
41 static int terminal_width
;
43 /* True if the error/warnings should be buffered. */
44 static bool buffered_p
;
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
;
52 /* Return buffered_p. */
59 /* Return true if there output_buffer is empty. */
62 gfc_output_buffer_empty_p (const output_buffer
* buf
)
64 return output_buffer_last_position_in_text (buf
) == NULL
;
67 /* Go one level deeper suppressing errors. */
70 gfc_push_suppress_errors (void)
72 gcc_assert (suppress_errors
>= 0);
77 gfc_error_opt (int opt
, const char *gmsgid
, va_list ap
) ATTRIBUTE_GCC_GFC(2,0);
80 gfc_warning (int opt
, const char *gmsgid
, va_list ap
) ATTRIBUTE_GCC_GFC(2,0);
83 /* Leave one level of error suppressing. */
86 gfc_pop_suppress_errors (void)
88 gcc_assert (suppress_errors
> 0);
93 /* Query whether errors are suppressed. */
96 gfc_query_suppress_errors (void)
98 return suppress_errors
> 0;
102 /* Determine terminal width (for trimming source lines in output). */
105 gfc_get_terminal_width (void)
107 return isatty (STDERR_FILENO
) ? get_terminal_width () : INT_MAX
;
111 /* Per-file error initialization. */
114 gfc_error_init_1 (void)
116 terminal_width
= gfc_get_terminal_width ();
117 gfc_buffer_error (false);
121 /* Set the flag for buffering errors or not. */
124 gfc_buffer_error (bool flag
)
130 /* Add a single character to the error buffer or output depending on
136 /* FIXME: Unused function to be removed in a subsequent patch. */
140 /* Copy a string to wherever it needs to go. */
143 error_string (const char *p
)
150 /* Print a formatted integer to the error buffer or output. */
155 error_uinteger (unsigned long long int i
)
157 char *p
, int_buf
[IBUF_LEN
];
159 p
= int_buf
+ IBUF_LEN
- 1;
171 error_string (p
+ 1);
175 error_integer (long long int i
)
177 unsigned long long int u
;
181 u
= (unsigned long long int) -i
;
192 error_hwuint (unsigned HOST_WIDE_INT i
)
194 char *p
, int_buf
[IBUF_LEN
];
196 p
= int_buf
+ IBUF_LEN
- 1;
208 error_string (p
+ 1);
212 error_hwint (HOST_WIDE_INT i
)
214 unsigned HOST_WIDE_INT u
;
218 u
= (unsigned HOST_WIDE_INT
) -i
;
229 gfc_widechar_display_length (gfc_char_t c
)
231 if (gfc_wide_is_printable (c
) || c
== '\t')
232 /* Printable ASCII character, or tabulation (output as a space). */
234 else if (c
< ((gfc_char_t
) 1 << 8))
235 /* Displayed as \x?? */
237 else if (c
< ((gfc_char_t
) 1 << 16))
238 /* Displayed as \u???? */
241 /* Displayed as \U???????? */
246 /* Length of the ASCII representation of the wide string, escaping wide
247 characters as print_wide_char_into_buffer() does. */
250 gfc_wide_display_length (const gfc_char_t
*str
)
254 for (i
= 0, len
= 0; str
[i
]; i
++)
255 len
+= gfc_widechar_display_length (str
[i
]);
261 print_wide_char_into_buffer (gfc_char_t c
, char *buf
)
263 static const char xdigit
[16] = { '0', '1', '2', '3', '4', '5', '6',
264 '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F' };
266 if (gfc_wide_is_printable (c
) || c
== '\t')
269 /* Tabulation is output as a space. */
270 buf
[0] = (unsigned char) (c
== '\t' ? ' ' : c
);
273 else if (c
< ((gfc_char_t
) 1 << 8))
276 buf
[3] = xdigit
[c
& 0x0F];
278 buf
[2] = xdigit
[c
& 0x0F];
284 else if (c
< ((gfc_char_t
) 1 << 16))
287 buf
[5] = xdigit
[c
& 0x0F];
289 buf
[4] = xdigit
[c
& 0x0F];
291 buf
[3] = xdigit
[c
& 0x0F];
293 buf
[2] = xdigit
[c
& 0x0F];
302 buf
[9] = xdigit
[c
& 0x0F];
304 buf
[8] = xdigit
[c
& 0x0F];
306 buf
[7] = xdigit
[c
& 0x0F];
308 buf
[6] = xdigit
[c
& 0x0F];
310 buf
[5] = xdigit
[c
& 0x0F];
312 buf
[4] = xdigit
[c
& 0x0F];
314 buf
[3] = xdigit
[c
& 0x0F];
316 buf
[2] = xdigit
[c
& 0x0F];
324 static char wide_char_print_buffer
[11];
327 gfc_print_wide_char (gfc_char_t c
)
329 print_wide_char_into_buffer (c
, wide_char_print_buffer
);
330 return wide_char_print_buffer
;
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. */
338 static void error_printf (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
341 show_locus (locus
*loc
, int c1
, int c2
)
348 /* TODO: Either limit the total length and number of included files
349 displayed or add buffering of arbitrary number of characters in
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. */
361 error_string (f
->filename
);
364 error_integer (LOCATION_LINE (lb
->location
));
366 if ((c1
> 0) || (c2
> 0))
372 if ((c1
> 0) && (c2
> 0))
383 i
= f
->inclusion_line
;
386 if (f
== NULL
) break;
388 error_printf (" Included at %s:%d:", f
->filename
, i
);
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. */
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. */
408 cmax
= (c1
< c2
) ? c2
: c1
;
409 if (cmax
> terminal_width
- 5)
410 offset
= cmax
- terminal_width
+ 5;
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. */
416 p
= &(lb
->line
[offset
]);
417 i
= gfc_wide_display_length (p
);
418 if (i
> terminal_width
)
419 i
= terminal_width
- 1;
423 static char buffer
[11];
424 i
-= print_wide_char_into_buffer (*p
++, buffer
);
425 error_string (buffer
);
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. */
438 p
= &(lb
->line
[offset
]);
439 for (i
= 0; i
< cmax
; i
++)
442 spaces
= gfc_widechar_display_length (*p
++);
445 error_char ('1'), spaces
--;
447 error_char ('2'), spaces
--;
449 for (j
= 0; j
< spaces
; j
++)
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. */
468 show_loci (locus
*l1
, locus
*l2
)
472 if (l1
== NULL
|| l1
->lb
== NULL
)
474 error_printf ("<During initialization>\n");
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. */
482 c1
= l1
->nextc
- l1
->lb
->line
;
485 show_locus (l1
, c1
, -1);
489 c2
= l2
->nextc
- l2
->lb
->line
;
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. */
499 if (l1
->lb
!= l2
->lb
|| m
> terminal_width
- 10)
501 show_locus (l1
, c1
, -1);
502 show_locus (l2
, -1, c2
);
506 show_locus (l1
, c1
, c2
);
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:
516 %c Character, %d or %i Integer, %s String, %% Percent
517 %L Takes locus argument
518 %C Current locus (no argument)
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.
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. */
534 static void ATTRIBUTE_GCC_GFC(2,0)
535 error_print (const char *type
, const char *format0
, va_list argp
)
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
};
547 unsigned int uintval
;
549 unsigned long int ulongintval
;
550 long long int llongintval
;
551 unsigned long long int ullongintval
;
552 HOST_WIDE_INT hwintval
;
553 unsigned HOST_WIDE_INT hwuintval
;
555 const char * stringval
;
557 } arg
[MAX_ARGS
], spec
[MAX_ARGS
];
558 /* spec is the array of specifiers, in the same order as they
559 appear in the format string. arg is the array of arguments,
560 in the same order as they appear in the va_list. */
563 int i
, n
, have_l1
, pos
, maxpos
;
564 locus
*l1
, *l2
, *loc
;
567 loc
= l1
= l2
= NULL
;
576 for (i
= 0; i
< MAX_ARGS
; i
++)
578 arg
[i
].type
= NOTYPE
;
582 /* First parse the format string for position specifiers. */
595 if (ISDIGIT (*format
))
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);
603 while (ISDIGIT(*format
))
605 gcc_assert (*format
== '$');
619 arg
[pos
].type
= TYPE_CURRENTLOC
;
623 arg
[pos
].type
= TYPE_LOCUS
;
628 arg
[pos
].type
= TYPE_INTEGER
;
632 arg
[pos
].type
= TYPE_UINTEGER
;
641 arg
[pos
].type
= TYPE_ULLONGINT
;
642 else if (c
== 'i' || c
== 'd')
643 arg
[pos
].type
= TYPE_LLONGINT
;
648 arg
[pos
].type
= TYPE_ULONGINT
;
649 else if (c
== 'i' || c
== 'd')
650 arg
[pos
].type
= TYPE_LONGINT
;
658 arg
[pos
].type
= TYPE_HWUINT
;
659 else if (c
== 'i' || c
== 'd')
660 arg
[pos
].type
= TYPE_HWINT
;
666 arg
[pos
].type
= TYPE_CHAR
;
670 arg
[pos
].type
= TYPE_STRING
;
680 /* Then convert the values for each %-style argument. */
681 for (pos
= 0; pos
<= maxpos
; pos
++)
683 gcc_assert (arg
[pos
].type
!= NOTYPE
);
684 switch (arg
[pos
].type
)
686 case TYPE_CURRENTLOC
:
687 loc
= &gfc_current_locus
;
691 if (arg
[pos
].type
== TYPE_LOCUS
)
692 loc
= va_arg (argp
, locus
*);
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')
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')
714 arg
[pos
].u
.intval
= va_arg (argp
, int);
718 arg
[pos
].u
.uintval
= va_arg (argp
, unsigned int);
722 arg
[pos
].u
.longintval
= va_arg (argp
, long int);
726 arg
[pos
].u
.ulongintval
= va_arg (argp
, unsigned long int);
730 arg
[pos
].u
.llongintval
= va_arg (argp
, long long int);
734 arg
[pos
].u
.ullongintval
= va_arg (argp
, unsigned long long int);
738 arg
[pos
].u
.hwintval
= va_arg (argp
, HOST_WIDE_INT
);
742 arg
[pos
].u
.hwuintval
= va_arg (argp
, unsigned HOST_WIDE_INT
);
746 arg
[pos
].u
.charval
= (char) va_arg (argp
, int);
750 arg
[pos
].u
.stringval
= (const char *) va_arg (argp
, char *);
758 for (n
= 0; spec
[n
].pos
>= 0; n
++)
759 spec
[n
].u
= arg
[spec
[n
].pos
].u
;
761 /* Show the current loci if we have to. */
775 for (; *format
; format
++)
779 error_char (*format
);
784 if (ISDIGIT (*format
))
786 /* This is a position specifier. See comment above. */
787 while (ISDIGIT (*format
))
790 /* Skip over the dollar sign. */
801 error_char (spec
[n
++].u
.charval
);
805 case 'C': /* Current locus */
806 case 'L': /* Specified locus */
807 error_string (spec
[n
++].u
.stringval
);
812 error_integer (spec
[n
++].u
.intval
);
816 error_uinteger (spec
[n
++].u
.uintval
);
825 error_uinteger (spec
[n
++].u
.ullongintval
);
827 error_integer (spec
[n
++].u
.llongintval
);
830 error_uinteger (spec
[n
++].u
.ulongintval
);
832 error_integer (spec
[n
++].u
.longintval
);
838 error_hwuint (spec
[n
++].u
.hwintval
);
840 error_hwint (spec
[n
++].u
.hwuintval
);
849 /* Wrapper for error_print(). */
852 error_printf (const char *gmsgid
, ...)
856 va_start (argp
, gmsgid
);
857 error_print ("", _(gmsgid
), argp
);
862 /* Clear any output buffered in a pretty-print output_buffer. */
865 gfc_clear_pp_buffer (output_buffer
*this_buffer
)
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
->m_last_location
= UNKNOWN_LOCATION
;
877 /* The currently-printing diagnostic, for use by gfc_format_decoder,
878 for colorizing %C and %L. */
880 static diagnostic_info
*curr_diagnostic
;
882 /* A helper function to call diagnostic_report_diagnostic, while setting
883 curr_diagnostic for the duration of the call. */
886 gfc_report_diagnostic (diagnostic_info
*diagnostic
)
888 gcc_assert (diagnostic
!= NULL
);
889 curr_diagnostic
= diagnostic
;
890 bool ret
= diagnostic_report_diagnostic (global_dc
, diagnostic
);
891 curr_diagnostic
= NULL
;
895 /* This is just a helper function to avoid duplicating the logic of
899 gfc_warning (int opt
, const char *gmsgid
, va_list ap
)
904 diagnostic_info diagnostic
;
905 rich_location
rich_loc (line_table
, UNKNOWN_LOCATION
);
906 bool fatal_errors
= global_dc
->m_fatal_errors
;
907 pretty_printer
*pp
= global_dc
->printer
;
908 output_buffer
*tmp_buffer
= pp
->buffer
;
910 gfc_clear_pp_buffer (pp_warning_buffer
);
914 pp
->buffer
= pp_warning_buffer
;
915 global_dc
->m_fatal_errors
= false;
916 /* To prevent -fmax-errors= triggering. */
920 diagnostic_set_info (&diagnostic
, gmsgid
, &argp
, &rich_loc
,
922 diagnostic
.option_index
= opt
;
923 bool ret
= gfc_report_diagnostic (&diagnostic
);
927 pp
->buffer
= tmp_buffer
;
928 global_dc
->m_fatal_errors
= fatal_errors
;
930 warningcount_buffered
= 0;
931 werrorcount_buffered
= 0;
932 /* Undo the above --werrorcount if not Werror, otherwise
933 werrorcount is correct already. */
936 else if (diagnostic
.kind
== DK_ERROR
)
937 ++werrorcount_buffered
;
939 ++werrorcount
, --warningcount
, ++warningcount_buffered
;
946 /* Issue a warning. */
949 gfc_warning (int opt
, const char *gmsgid
, ...)
953 va_start (argp
, gmsgid
);
954 bool ret
= gfc_warning (opt
, gmsgid
, argp
);
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. */
964 gfc_notification_std (int std
)
968 warning
= ((gfc_option
.warn_std
& std
) != 0) && !inhibit_warnings
;
969 if ((gfc_option
.allow_std
& std
) != 0 && !warning
)
972 return warning
? WARNING
: ERROR
;
976 /* Return a string describing the nature of a standard violation
977 * and/or the relevant version of the standard. */
980 notify_std_msg(int std
)
983 if (std
& GFC_STD_F2023_DEL
)
984 return _("Prohibited in Fortran 2023:");
985 else if (std
& GFC_STD_F2023
)
986 return _("Fortran 2023:");
987 else if (std
& GFC_STD_F2018_DEL
)
988 return _("Fortran 2018 deleted feature:");
989 else if (std
& GFC_STD_F2018_OBS
)
990 return _("Fortran 2018 obsolescent feature:");
991 else if (std
& GFC_STD_F2018
)
992 return _("Fortran 2018:");
993 else if (std
& GFC_STD_F2008_OBS
)
994 return _("Fortran 2008 obsolescent feature:");
995 else if (std
& GFC_STD_F2008
)
996 return "Fortran 2008:";
997 else if (std
& GFC_STD_F2003
)
998 return "Fortran 2003:";
999 else if (std
& GFC_STD_GNU
)
1000 return _("GNU Extension:");
1001 else if (std
& GFC_STD_LEGACY
)
1002 return _("Legacy Extension:");
1003 else if (std
& GFC_STD_F95_OBS
)
1004 return _("Obsolescent feature:");
1005 else if (std
& GFC_STD_F95_DEL
)
1006 return _("Deleted feature:");
1012 /* Possibly issue a warning/error about use of a nonstandard (or deleted)
1013 feature. An error/warning will be issued if the currently selected
1014 standard does not contain the requested bits. Return false if
1015 an error is generated. */
1018 gfc_notify_std (int std
, const char *gmsgid
, ...)
1021 const char *msg
, *msg2
;
1024 /* Determine whether an error or a warning is needed. */
1025 const int wstd
= std
& gfc_option
.warn_std
; /* Standard to warn about. */
1026 const int estd
= std
& ~gfc_option
.allow_std
; /* Standard to error about. */
1027 const bool warning
= (wstd
!= 0) && !inhibit_warnings
;
1028 const bool error
= (estd
!= 0);
1030 if (!error
&& !warning
)
1032 if (suppress_errors
)
1036 msg
= notify_std_msg (estd
);
1038 msg
= notify_std_msg (wstd
);
1041 buffer
= (char *) alloca (strlen (msg
) + strlen (msg2
) + 2);
1042 strcpy (buffer
, msg
);
1043 strcat (buffer
, " ");
1044 strcat (buffer
, msg2
);
1046 va_start (argp
, gmsgid
);
1048 gfc_error_opt (0, buffer
, argp
);
1050 gfc_warning (0, buffer
, argp
);
1056 return (warning
&& !warnings_are_errors
);
1060 /* Called from output_format -- during diagnostic message processing
1061 to handle Fortran specific format specifiers with the following meanings:
1063 %C Current locus (no argument)
1064 %L Takes locus argument
1067 gfc_format_decoder (pretty_printer
*pp
, text_info
*text
, const char *spec
,
1068 int precision
, bool wide
, bool set_locus
, bool hash
,
1069 bool *quoted
, const char **buffer_ptr
)
1076 static const char *result
[2] = { "(1)", "(2)" };
1079 loc
= &gfc_current_locus
;
1081 loc
= va_arg (*text
->m_args_ptr
, locus
*);
1082 gcc_assert (loc
->nextc
- loc
->lb
->line
>= 0);
1083 unsigned int offset
= loc
->nextc
- loc
->lb
->line
;
1084 if (*spec
== 'C' && *loc
->nextc
!= '\0')
1085 /* Point %C first offending character not the last good one. */
1087 /* If location[0] != UNKNOWN_LOCATION means that we already
1088 processed one of %C/%L. */
1089 int loc_num
= text
->get_location (0) == UNKNOWN_LOCATION
? 0 : 1;
1091 = linemap_position_for_loc_and_offset (line_table
,
1094 text
->set_location (loc_num
, src_loc
, SHOW_RANGE_WITH_CARET
);
1095 /* Colorize the markers to match the color choices of
1096 diagnostic_show_locus (the initial location has a color given
1097 by the "kind" of the diagnostic, the secondary location has
1099 gcc_assert (curr_diagnostic
!= NULL
);
1103 : diagnostic_get_color_for_kind (curr_diagnostic
->kind
));
1104 pp_string (pp
, colorize_start (pp_show_color (pp
), color
));
1105 pp_string (pp
, result
[loc_num
]);
1106 pp_string (pp
, colorize_stop (pp_show_color (pp
)));
1110 /* Fall through info the middle-end decoder, as e.g. stor-layout.cc
1111 etc. diagnostics can use the FE printer while the FE is still
1113 return default_tree_printer (pp
, text
, spec
, precision
, wide
,
1114 set_locus
, hash
, quoted
, buffer_ptr
);
1118 /* Return a malloc'd string describing the kind of diagnostic. The
1119 caller is responsible for freeing the memory. */
1121 gfc_diagnostic_build_kind_prefix (diagnostic_context
*context
,
1122 const diagnostic_info
*diagnostic
)
1124 static const char *const diagnostic_kind_text
[] = {
1125 #define DEFINE_DIAGNOSTIC_KIND(K, T, C) (T),
1126 #include "gfc-diagnostic.def"
1127 #undef DEFINE_DIAGNOSTIC_KIND
1130 static const char *const diagnostic_kind_color
[] = {
1131 #define DEFINE_DIAGNOSTIC_KIND(K, T, C) (C),
1132 #include "gfc-diagnostic.def"
1133 #undef DEFINE_DIAGNOSTIC_KIND
1136 gcc_assert (diagnostic
->kind
< DK_LAST_DIAGNOSTIC_KIND
);
1137 const char *text
= _(diagnostic_kind_text
[diagnostic
->kind
]);
1138 const char *text_cs
= "", *text_ce
= "";
1139 pretty_printer
*pp
= context
->printer
;
1141 if (diagnostic_kind_color
[diagnostic
->kind
])
1143 text_cs
= colorize_start (pp_show_color (pp
),
1144 diagnostic_kind_color
[diagnostic
->kind
]);
1145 text_ce
= colorize_stop (pp_show_color (pp
));
1147 return build_message_string ("%s%s:%s ", text_cs
, text
, text_ce
);
1150 /* Return a malloc'd string describing a location. The caller is
1151 responsible for freeing the memory. */
1153 gfc_diagnostic_build_locus_prefix (diagnostic_context
*context
,
1154 expanded_location s
)
1156 pretty_printer
*pp
= context
->printer
;
1157 const char *locus_cs
= colorize_start (pp_show_color (pp
), "locus");
1158 const char *locus_ce
= colorize_stop (pp_show_color (pp
));
1159 return (s
.file
== NULL
1160 ? build_message_string ("%s%s:%s", locus_cs
, progname
, locus_ce
)
1161 : !strcmp (s
.file
, special_fname_builtin ())
1162 ? build_message_string ("%s%s:%s", locus_cs
, s
.file
, locus_ce
)
1163 : context
->m_show_column
1164 ? build_message_string ("%s%s:%d:%d:%s", locus_cs
, s
.file
, s
.line
,
1166 : build_message_string ("%s%s:%d:%s", locus_cs
, s
.file
, s
.line
, locus_ce
));
1169 /* Return a malloc'd string describing two locations. The caller is
1170 responsible for freeing the memory. */
1172 gfc_diagnostic_build_locus_prefix (diagnostic_context
*context
,
1173 expanded_location s
, expanded_location s2
)
1175 pretty_printer
*pp
= context
->printer
;
1176 const char *locus_cs
= colorize_start (pp_show_color (pp
), "locus");
1177 const char *locus_ce
= colorize_stop (pp_show_color (pp
));
1179 return (s
.file
== NULL
1180 ? build_message_string ("%s%s:%s", locus_cs
, progname
, locus_ce
)
1181 : !strcmp (s
.file
, special_fname_builtin ())
1182 ? build_message_string ("%s%s:%s", locus_cs
, s
.file
, locus_ce
)
1183 : context
->m_show_column
1184 ? build_message_string ("%s%s:%d:%d-%d:%s", locus_cs
, s
.file
, s
.line
,
1185 MIN (s
.column
, s2
.column
),
1186 MAX (s
.column
, s2
.column
), locus_ce
)
1187 : build_message_string ("%s%s:%d:%s", locus_cs
, s
.file
, s
.line
,
1191 /* This function prints the locus (file:line:column), the diagnostic kind
1192 (Error, Warning) and (optionally) the relevant lines of code with
1193 annotation lines with '1' and/or '2' below them.
1195 With -fdiagnostic-show-caret (the default) it prints:
1197 [locus of primary range]:
1201 Error: Some error at (1)
1203 With -fno-diagnostic-show-caret or if the primary range is not
1206 [locus of primary range]: Error: Some error at (1) and (2)
1209 gfc_diagnostic_starter (diagnostic_context
*context
,
1210 const diagnostic_info
*diagnostic
)
1212 char * kind_prefix
= gfc_diagnostic_build_kind_prefix (context
, diagnostic
);
1214 expanded_location s1
= diagnostic_expand_location (diagnostic
);
1215 expanded_location s2
;
1216 bool one_locus
= diagnostic
->richloc
->get_num_locations () < 2;
1217 bool same_locus
= false;
1221 s2
= diagnostic_expand_location (diagnostic
, 1);
1222 same_locus
= diagnostic_same_line (context
, s1
, s2
);
1225 char * locus_prefix
= (one_locus
|| !same_locus
)
1226 ? gfc_diagnostic_build_locus_prefix (context
, s1
)
1227 : gfc_diagnostic_build_locus_prefix (context
, s1
, s2
);
1229 if (!context
->m_source_printing
.enabled
1230 || diagnostic_location (diagnostic
, 0) <= BUILTINS_LOCATION
1231 || diagnostic_location (diagnostic
, 0) == context
->m_last_location
)
1233 pp_set_prefix (context
->printer
,
1234 concat (locus_prefix
, " ", kind_prefix
, NULL
));
1235 free (locus_prefix
);
1237 if (one_locus
|| same_locus
)
1242 /* In this case, we print the previous locus and prefix as:
1244 [locus]:[prefix]: (1)
1246 and we flush with a new line before setting the new prefix. */
1247 pp_string (context
->printer
, "(1)");
1248 pp_newline (context
->printer
);
1249 locus_prefix
= gfc_diagnostic_build_locus_prefix (context
, s2
);
1250 pp_set_prefix (context
->printer
,
1251 concat (locus_prefix
, " ", kind_prefix
, NULL
));
1253 free (locus_prefix
);
1257 pp_verbatim (context
->printer
, "%s", locus_prefix
);
1258 free (locus_prefix
);
1259 /* Fortran uses an empty line between locus and caret line. */
1260 pp_newline (context
->printer
);
1261 pp_set_prefix (context
->printer
, NULL
);
1262 pp_newline (context
->printer
);
1263 diagnostic_show_locus (context
, diagnostic
->richloc
, diagnostic
->kind
);
1264 /* If the caret line was shown, the prefix does not contain the
1266 pp_set_prefix (context
->printer
, kind_prefix
);
1271 gfc_diagnostic_start_span (diagnostic_context
*context
,
1272 expanded_location exploc
)
1275 locus_prefix
= gfc_diagnostic_build_locus_prefix (context
, exploc
);
1276 pp_verbatim (context
->printer
, "%s", locus_prefix
);
1277 free (locus_prefix
);
1278 pp_newline (context
->printer
);
1279 /* Fortran uses an empty line between locus and caret line. */
1280 pp_newline (context
->printer
);
1285 gfc_diagnostic_finalizer (diagnostic_context
*context
,
1286 const diagnostic_info
*diagnostic ATTRIBUTE_UNUSED
,
1287 diagnostic_t orig_diag_kind ATTRIBUTE_UNUSED
)
1289 pp_destroy_prefix (context
->printer
);
1290 pp_newline_and_flush (context
->printer
);
1293 /* Immediate warning (i.e. do not buffer the warning) with an explicit
1297 gfc_warning_now_at (location_t loc
, int opt
, const char *gmsgid
, ...)
1300 diagnostic_info diagnostic
;
1301 rich_location
rich_loc (line_table
, loc
);
1304 va_start (argp
, gmsgid
);
1305 diagnostic_set_info (&diagnostic
, gmsgid
, &argp
, &rich_loc
, DK_WARNING
);
1306 diagnostic
.option_index
= opt
;
1307 ret
= gfc_report_diagnostic (&diagnostic
);
1312 /* Immediate warning (i.e. do not buffer the warning). */
1315 gfc_warning_now (int opt
, const char *gmsgid
, ...)
1318 diagnostic_info diagnostic
;
1319 rich_location
rich_loc (line_table
, UNKNOWN_LOCATION
);
1322 va_start (argp
, gmsgid
);
1323 diagnostic_set_info (&diagnostic
, gmsgid
, &argp
, &rich_loc
,
1325 diagnostic
.option_index
= opt
;
1326 ret
= gfc_report_diagnostic (&diagnostic
);
1331 /* Internal warning, do not buffer. */
1334 gfc_warning_internal (int opt
, const char *gmsgid
, ...)
1337 diagnostic_info diagnostic
;
1338 rich_location
rich_loc (line_table
, UNKNOWN_LOCATION
);
1341 va_start (argp
, gmsgid
);
1342 diagnostic_set_info (&diagnostic
, gmsgid
, &argp
, &rich_loc
,
1344 diagnostic
.option_index
= opt
;
1345 ret
= gfc_report_diagnostic (&diagnostic
);
1350 /* Immediate error (i.e. do not buffer). */
1353 gfc_error_now (const char *gmsgid
, ...)
1356 diagnostic_info diagnostic
;
1357 rich_location
rich_loc (line_table
, UNKNOWN_LOCATION
);
1359 error_buffer
.flag
= true;
1361 va_start (argp
, gmsgid
);
1362 diagnostic_set_info (&diagnostic
, gmsgid
, &argp
, &rich_loc
, DK_ERROR
);
1363 gfc_report_diagnostic (&diagnostic
);
1368 /* Fatal error, never returns. */
1371 gfc_fatal_error (const char *gmsgid
, ...)
1374 diagnostic_info diagnostic
;
1375 rich_location
rich_loc (line_table
, UNKNOWN_LOCATION
);
1377 va_start (argp
, gmsgid
);
1378 diagnostic_set_info (&diagnostic
, gmsgid
, &argp
, &rich_loc
, DK_FATAL
);
1379 gfc_report_diagnostic (&diagnostic
);
1385 /* Clear the warning flag. */
1388 gfc_clear_warning (void)
1390 gfc_clear_pp_buffer (pp_warning_buffer
);
1391 warningcount_buffered
= 0;
1392 werrorcount_buffered
= 0;
1396 /* Check to see if any warnings have been saved.
1397 If so, print the warning. */
1400 gfc_warning_check (void)
1402 if (! gfc_output_buffer_empty_p (pp_warning_buffer
))
1404 pretty_printer
*pp
= global_dc
->printer
;
1405 output_buffer
*tmp_buffer
= pp
->buffer
;
1406 pp
->buffer
= pp_warning_buffer
;
1407 pp_really_flush (pp
);
1408 warningcount
+= warningcount_buffered
;
1409 werrorcount
+= werrorcount_buffered
;
1410 gcc_assert (warningcount_buffered
+ werrorcount_buffered
== 1);
1411 pp
->buffer
= tmp_buffer
;
1412 diagnostic_action_after_output (global_dc
,
1413 warningcount_buffered
1414 ? DK_WARNING
: DK_ERROR
);
1415 diagnostic_check_max_errors (global_dc
, true);
1420 /* Issue an error. */
1423 gfc_error_opt (int opt
, const char *gmsgid
, va_list ap
)
1427 bool saved_abort_on_error
= false;
1429 if (warnings_not_errors
)
1431 gfc_warning (opt
, gmsgid
, argp
);
1436 if (suppress_errors
)
1442 diagnostic_info diagnostic
;
1443 rich_location
richloc (line_table
, UNKNOWN_LOCATION
);
1444 bool fatal_errors
= global_dc
->m_fatal_errors
;
1445 pretty_printer
*pp
= global_dc
->printer
;
1446 output_buffer
*tmp_buffer
= pp
->buffer
;
1448 gfc_clear_pp_buffer (pp_error_buffer
);
1452 /* To prevent -dH from triggering an abort on a buffered error,
1453 save abort_on_error and restore it below. */
1454 saved_abort_on_error
= global_dc
->m_abort_on_error
;
1455 global_dc
->m_abort_on_error
= false;
1456 pp
->buffer
= pp_error_buffer
;
1457 global_dc
->m_fatal_errors
= false;
1458 /* To prevent -fmax-errors= triggering, we decrease it before
1459 report_diagnostic increases it. */
1463 diagnostic_set_info (&diagnostic
, gmsgid
, &argp
, &richloc
, DK_ERROR
);
1464 gfc_report_diagnostic (&diagnostic
);
1468 pp
->buffer
= tmp_buffer
;
1469 global_dc
->m_fatal_errors
= fatal_errors
;
1470 global_dc
->m_abort_on_error
= saved_abort_on_error
;
1479 gfc_error_opt (int opt
, const char *gmsgid
, ...)
1482 va_start (argp
, gmsgid
);
1483 gfc_error_opt (opt
, gmsgid
, argp
);
1489 gfc_error (const char *gmsgid
, ...)
1492 va_start (argp
, gmsgid
);
1493 gfc_error_opt (0, gmsgid
, argp
);
1498 /* This shouldn't happen... but sometimes does. */
1501 gfc_internal_error (const char *gmsgid
, ...)
1505 diagnostic_info diagnostic
;
1506 rich_location
rich_loc (line_table
, UNKNOWN_LOCATION
);
1508 gfc_get_errors (&w
, &e
);
1512 va_start (argp
, gmsgid
);
1513 diagnostic_set_info (&diagnostic
, gmsgid
, &argp
, &rich_loc
, DK_ICE
);
1514 gfc_report_diagnostic (&diagnostic
);
1521 /* Clear the error flag when we start to compile a source line. */
1524 gfc_clear_error (void)
1526 error_buffer
.flag
= false;
1527 warnings_not_errors
= false;
1528 gfc_clear_pp_buffer (pp_error_buffer
);
1532 /* Tests the state of error_flag. */
1535 gfc_error_flag_test (void)
1537 return error_buffer
.flag
1538 || !gfc_output_buffer_empty_p (pp_error_buffer
);
1542 /* Check to see if any errors have been saved.
1543 If so, print the error. Returns the state of error_flag. */
1546 gfc_error_check (void)
1548 if (error_buffer
.flag
1549 || ! gfc_output_buffer_empty_p (pp_error_buffer
))
1551 error_buffer
.flag
= false;
1552 pretty_printer
*pp
= global_dc
->printer
;
1553 output_buffer
*tmp_buffer
= pp
->buffer
;
1554 pp
->buffer
= pp_error_buffer
;
1555 pp_really_flush (pp
);
1557 gcc_assert (gfc_output_buffer_empty_p (pp_error_buffer
));
1558 pp
->buffer
= tmp_buffer
;
1559 diagnostic_action_after_output (global_dc
, DK_ERROR
);
1560 diagnostic_check_max_errors (global_dc
, true);
1567 /* Move the text buffered from FROM to TO, then clear
1568 FROM. Independently if there was text in FROM, TO is also
1572 gfc_move_error_buffer_from_to (gfc_error_buffer
* buffer_from
,
1573 gfc_error_buffer
* buffer_to
)
1575 output_buffer
* from
= &(buffer_from
->buffer
);
1576 output_buffer
* to
= &(buffer_to
->buffer
);
1578 buffer_to
->flag
= buffer_from
->flag
;
1579 buffer_from
->flag
= false;
1581 gfc_clear_pp_buffer (to
);
1582 /* We make sure this is always buffered. */
1583 to
->flush_p
= false;
1585 if (! gfc_output_buffer_empty_p (from
))
1587 const char *str
= output_buffer_formatted_text (from
);
1588 output_buffer_append_r (to
, str
, strlen (str
));
1589 gfc_clear_pp_buffer (from
);
1593 /* Save the existing error state. */
1596 gfc_push_error (gfc_error_buffer
*err
)
1598 gfc_move_error_buffer_from_to (&error_buffer
, err
);
1602 /* Restore a previous pushed error state. */
1605 gfc_pop_error (gfc_error_buffer
*err
)
1607 gfc_move_error_buffer_from_to (err
, &error_buffer
);
1611 /* Free a pushed error state, but keep the current error state. */
1614 gfc_free_error (gfc_error_buffer
*err
)
1616 gfc_clear_pp_buffer (&(err
->buffer
));
1620 /* Report the number of warnings and errors that occurred to the caller. */
1623 gfc_get_errors (int *w
, int *e
)
1626 *w
= warningcount
+ werrorcount
;
1628 *e
= errorcount
+ sorrycount
+ werrorcount
;
1632 /* Switch errors into warnings. */
1635 gfc_errors_to_warnings (bool f
)
1637 warnings_not_errors
= f
;
1641 gfc_diagnostics_init (void)
1643 diagnostic_starter (global_dc
) = gfc_diagnostic_starter
;
1644 diagnostic_start_span (global_dc
) = gfc_diagnostic_start_span
;
1645 diagnostic_finalizer (global_dc
) = gfc_diagnostic_finalizer
;
1646 diagnostic_format_decoder (global_dc
) = gfc_format_decoder
;
1647 global_dc
->m_source_printing
.caret_chars
[0] = '1';
1648 global_dc
->m_source_printing
.caret_chars
[1] = '2';
1649 pp_warning_buffer
= new (XNEW (output_buffer
)) output_buffer ();
1650 pp_warning_buffer
->flush_p
= false;
1651 /* pp_error_buffer is statically allocated. This simplifies memory
1652 management when using gfc_push/pop_error. */
1653 pp_error_buffer
= &(error_buffer
.buffer
);
1654 pp_error_buffer
->flush_p
= false;
1658 gfc_diagnostics_finish (void)
1660 tree_diagnostics_defaults (global_dc
);
1661 /* We still want to use the gfc starter and finalizer, not the tree
1663 diagnostic_starter (global_dc
) = gfc_diagnostic_starter
;
1664 diagnostic_finalizer (global_dc
) = gfc_diagnostic_finalizer
;
1665 global_dc
->m_source_printing
.caret_chars
[0] = '^';
1666 global_dc
->m_source_printing
.caret_chars
[1] = '^';