2 Copyright (C) 2000-2022 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 true if there output_buffer is empty. */
55 gfc_output_buffer_empty_p (const output_buffer
* buf
)
57 return output_buffer_last_position_in_text (buf
) == NULL
;
60 /* Go one level deeper suppressing errors. */
63 gfc_push_suppress_errors (void)
65 gcc_assert (suppress_errors
>= 0);
70 gfc_error_opt (int opt
, const char *gmsgid
, va_list ap
) ATTRIBUTE_GCC_GFC(2,0);
73 gfc_warning (int opt
, const char *gmsgid
, va_list ap
) ATTRIBUTE_GCC_GFC(2,0);
76 /* Leave one level of error suppressing. */
79 gfc_pop_suppress_errors (void)
81 gcc_assert (suppress_errors
> 0);
86 /* Query whether errors are suppressed. */
89 gfc_query_suppress_errors (void)
91 return suppress_errors
> 0;
95 /* Determine terminal width (for trimming source lines in output). */
98 gfc_get_terminal_width (void)
100 return isatty (STDERR_FILENO
) ? get_terminal_width () : INT_MAX
;
104 /* Per-file error initialization. */
107 gfc_error_init_1 (void)
109 terminal_width
= gfc_get_terminal_width ();
110 gfc_buffer_error (false);
114 /* Set the flag for buffering errors or not. */
117 gfc_buffer_error (bool flag
)
123 /* Add a single character to the error buffer or output depending on
129 /* FIXME: Unused function to be removed in a subsequent patch. */
133 /* Copy a string to wherever it needs to go. */
136 error_string (const char *p
)
143 /* Print a formatted integer to the error buffer or output. */
148 error_uinteger (unsigned long long int i
)
150 char *p
, int_buf
[IBUF_LEN
];
152 p
= int_buf
+ IBUF_LEN
- 1;
164 error_string (p
+ 1);
168 error_integer (long long int i
)
170 unsigned long long int u
;
174 u
= (unsigned long long int) -i
;
185 error_hwuint (unsigned HOST_WIDE_INT i
)
187 char *p
, int_buf
[IBUF_LEN
];
189 p
= int_buf
+ IBUF_LEN
- 1;
201 error_string (p
+ 1);
205 error_hwint (HOST_WIDE_INT i
)
207 unsigned HOST_WIDE_INT u
;
211 u
= (unsigned HOST_WIDE_INT
) -i
;
222 gfc_widechar_display_length (gfc_char_t c
)
224 if (gfc_wide_is_printable (c
) || c
== '\t')
225 /* Printable ASCII character, or tabulation (output as a space). */
227 else if (c
< ((gfc_char_t
) 1 << 8))
228 /* Displayed as \x?? */
230 else if (c
< ((gfc_char_t
) 1 << 16))
231 /* Displayed as \u???? */
234 /* Displayed as \U???????? */
239 /* Length of the ASCII representation of the wide string, escaping wide
240 characters as print_wide_char_into_buffer() does. */
243 gfc_wide_display_length (const gfc_char_t
*str
)
247 for (i
= 0, len
= 0; str
[i
]; i
++)
248 len
+= gfc_widechar_display_length (str
[i
]);
254 print_wide_char_into_buffer (gfc_char_t c
, char *buf
)
256 static const char xdigit
[16] = { '0', '1', '2', '3', '4', '5', '6',
257 '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F' };
259 if (gfc_wide_is_printable (c
) || c
== '\t')
262 /* Tabulation is output as a space. */
263 buf
[0] = (unsigned char) (c
== '\t' ? ' ' : c
);
266 else if (c
< ((gfc_char_t
) 1 << 8))
269 buf
[3] = xdigit
[c
& 0x0F];
271 buf
[2] = xdigit
[c
& 0x0F];
277 else if (c
< ((gfc_char_t
) 1 << 16))
280 buf
[5] = xdigit
[c
& 0x0F];
282 buf
[4] = xdigit
[c
& 0x0F];
284 buf
[3] = xdigit
[c
& 0x0F];
286 buf
[2] = xdigit
[c
& 0x0F];
295 buf
[9] = xdigit
[c
& 0x0F];
297 buf
[8] = xdigit
[c
& 0x0F];
299 buf
[7] = xdigit
[c
& 0x0F];
301 buf
[6] = xdigit
[c
& 0x0F];
303 buf
[5] = xdigit
[c
& 0x0F];
305 buf
[4] = xdigit
[c
& 0x0F];
307 buf
[3] = xdigit
[c
& 0x0F];
309 buf
[2] = xdigit
[c
& 0x0F];
317 static char wide_char_print_buffer
[11];
320 gfc_print_wide_char (gfc_char_t c
)
322 print_wide_char_into_buffer (c
, wide_char_print_buffer
);
323 return wide_char_print_buffer
;
327 /* Show the file, where it was included, and the source line, give a
328 locus. Calls error_printf() recursively, but the recursion is at
329 most one level deep. */
331 static void error_printf (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
334 show_locus (locus
*loc
, int c1
, int c2
)
341 /* TODO: Either limit the total length and number of included files
342 displayed or add buffering of arbitrary number of characters in
345 /* Write out the error header line, giving the source file and error
346 location (in GNU standard "[file]:[line].[column]:" format),
347 followed by an "included by" stack and a blank line. This header
348 format is matched by a testsuite parser defined in
349 lib/gfortran-dg.exp. */
354 error_string (f
->filename
);
357 error_integer (LOCATION_LINE (lb
->location
));
359 if ((c1
> 0) || (c2
> 0))
365 if ((c1
> 0) && (c2
> 0))
376 i
= f
->inclusion_line
;
379 if (f
== NULL
) break;
381 error_printf (" Included at %s:%d:", f
->filename
, i
);
386 /* Calculate an appropriate horizontal offset of the source line in
387 order to get the error locus within the visible portion of the
388 line. Note that if the margin of 5 here is changed, the
389 corresponding margin of 10 in show_loci should be changed. */
393 /* If the two loci would appear in the same column, we shift
394 '2' one column to the right, so as to print '12' rather than
395 just '1'. We do this here so it will be accounted for in the
396 margin calculations. */
401 cmax
= (c1
< c2
) ? c2
: c1
;
402 if (cmax
> terminal_width
- 5)
403 offset
= cmax
- terminal_width
+ 5;
405 /* Show the line itself, taking care not to print more than what can
406 show up on the terminal. Tabs are converted to spaces, and
407 nonprintable characters are converted to a "\xNN" sequence. */
409 p
= &(lb
->line
[offset
]);
410 i
= gfc_wide_display_length (p
);
411 if (i
> terminal_width
)
412 i
= terminal_width
- 1;
416 static char buffer
[11];
417 i
-= print_wide_char_into_buffer (*p
++, buffer
);
418 error_string (buffer
);
423 /* Show the '1' and/or '2' corresponding to the column of the error
424 locus. Note that a value of -1 for c1 or c2 will simply cause
425 the relevant number not to be printed. */
431 p
= &(lb
->line
[offset
]);
432 for (i
= 0; i
< cmax
; i
++)
435 spaces
= gfc_widechar_display_length (*p
++);
438 error_char ('1'), spaces
--;
440 error_char ('2'), spaces
--;
442 for (j
= 0; j
< spaces
; j
++)
456 /* As part of printing an error, we show the source lines that caused
457 the problem. We show at least one, and possibly two loci; the two
458 loci may or may not be on the same source line. */
461 show_loci (locus
*l1
, locus
*l2
)
465 if (l1
== NULL
|| l1
->lb
== NULL
)
467 error_printf ("<During initialization>\n");
471 /* While calculating parameters for printing the loci, we consider possible
472 reasons for printing one per line. If appropriate, print the loci
473 individually; otherwise we print them both on the same line. */
475 c1
= l1
->nextc
- l1
->lb
->line
;
478 show_locus (l1
, c1
, -1);
482 c2
= l2
->nextc
- l2
->lb
->line
;
489 /* Note that the margin value of 10 here needs to be less than the
490 margin of 5 used in the calculation of offset in show_locus. */
492 if (l1
->lb
!= l2
->lb
|| m
> terminal_width
- 10)
494 show_locus (l1
, c1
, -1);
495 show_locus (l2
, -1, c2
);
499 show_locus (l1
, c1
, c2
);
505 /* Workhorse for the error printing subroutines. This subroutine is
506 inspired by g77's error handling and is similar to printf() with
507 the following %-codes:
509 %c Character, %d or %i Integer, %s String, %% Percent
510 %L Takes locus argument
511 %C Current locus (no argument)
513 If a locus pointer is given, the actual source line is printed out
514 and the column is indicated. Since we want the error message at
515 the bottom of any source file information, we must scan the
516 argument list twice -- once to determine whether the loci are
517 present and record this for printing, and once to print the error
518 message after and loci have been printed. A maximum of two locus
519 arguments are permitted.
521 This function is also called (recursively) by show_locus in the
522 case of included files; however, as show_locus does not resupply
523 any loci, the recursion is at most one level deep. */
527 static void ATTRIBUTE_GCC_GFC(2,0)
528 error_print (const char *type
, const char *format0
, va_list argp
)
530 enum { TYPE_CURRENTLOC
, TYPE_LOCUS
, TYPE_INTEGER
, TYPE_UINTEGER
,
531 TYPE_LONGINT
, TYPE_ULONGINT
, TYPE_LLONGINT
, TYPE_ULLONGINT
,
532 TYPE_HWINT
, TYPE_HWUINT
, TYPE_CHAR
, TYPE_STRING
, NOTYPE
};
540 unsigned int uintval
;
542 unsigned long int ulongintval
;
543 long long int llongintval
;
544 unsigned long long int ullongintval
;
545 HOST_WIDE_INT hwintval
;
546 unsigned HOST_WIDE_INT hwuintval
;
548 const char * stringval
;
550 } arg
[MAX_ARGS
], spec
[MAX_ARGS
];
551 /* spec is the array of specifiers, in the same order as they
552 appear in the format string. arg is the array of arguments,
553 in the same order as they appear in the va_list. */
556 int i
, n
, have_l1
, pos
, maxpos
;
557 locus
*l1
, *l2
, *loc
;
560 loc
= l1
= l2
= NULL
;
569 for (i
= 0; i
< MAX_ARGS
; i
++)
571 arg
[i
].type
= NOTYPE
;
575 /* First parse the format string for position specifiers. */
588 if (ISDIGIT (*format
))
590 /* This is a position specifier. For example, the number
591 12 in the format string "%12$d", which specifies the third
592 argument of the va_list, formatted in %d format.
593 For details, see "man 3 printf". */
594 pos
= atoi(format
) - 1;
595 gcc_assert (pos
>= 0);
596 while (ISDIGIT(*format
))
598 gcc_assert (*format
== '$');
612 arg
[pos
].type
= TYPE_CURRENTLOC
;
616 arg
[pos
].type
= TYPE_LOCUS
;
621 arg
[pos
].type
= TYPE_INTEGER
;
625 arg
[pos
].type
= TYPE_UINTEGER
;
634 arg
[pos
].type
= TYPE_ULLONGINT
;
635 else if (c
== 'i' || c
== 'd')
636 arg
[pos
].type
= TYPE_LLONGINT
;
641 arg
[pos
].type
= TYPE_ULONGINT
;
642 else if (c
== 'i' || c
== 'd')
643 arg
[pos
].type
= TYPE_LONGINT
;
651 arg
[pos
].type
= TYPE_HWUINT
;
652 else if (c
== 'i' || c
== 'd')
653 arg
[pos
].type
= TYPE_HWINT
;
659 arg
[pos
].type
= TYPE_CHAR
;
663 arg
[pos
].type
= TYPE_STRING
;
673 /* Then convert the values for each %-style argument. */
674 for (pos
= 0; pos
<= maxpos
; pos
++)
676 gcc_assert (arg
[pos
].type
!= NOTYPE
);
677 switch (arg
[pos
].type
)
679 case TYPE_CURRENTLOC
:
680 loc
= &gfc_current_locus
;
684 if (arg
[pos
].type
== TYPE_LOCUS
)
685 loc
= va_arg (argp
, locus
*);
690 arg
[pos
].u
.stringval
= "(2)";
691 /* Point %C first offending character not the last good one. */
692 if (arg
[pos
].type
== TYPE_CURRENTLOC
&& *l2
->nextc
!= '\0')
699 arg
[pos
].u
.stringval
= "(1)";
700 /* Point %C first offending character not the last good one. */
701 if (arg
[pos
].type
== TYPE_CURRENTLOC
&& *l1
->nextc
!= '\0')
707 arg
[pos
].u
.intval
= va_arg (argp
, int);
711 arg
[pos
].u
.uintval
= va_arg (argp
, unsigned int);
715 arg
[pos
].u
.longintval
= va_arg (argp
, long int);
719 arg
[pos
].u
.ulongintval
= va_arg (argp
, unsigned long int);
723 arg
[pos
].u
.llongintval
= va_arg (argp
, long long int);
727 arg
[pos
].u
.ullongintval
= va_arg (argp
, unsigned long long int);
731 arg
[pos
].u
.hwintval
= va_arg (argp
, HOST_WIDE_INT
);
735 arg
[pos
].u
.hwuintval
= va_arg (argp
, unsigned HOST_WIDE_INT
);
739 arg
[pos
].u
.charval
= (char) va_arg (argp
, int);
743 arg
[pos
].u
.stringval
= (const char *) va_arg (argp
, char *);
751 for (n
= 0; spec
[n
].pos
>= 0; n
++)
752 spec
[n
].u
= arg
[spec
[n
].pos
].u
;
754 /* Show the current loci if we have to. */
768 for (; *format
; format
++)
772 error_char (*format
);
777 if (ISDIGIT (*format
))
779 /* This is a position specifier. See comment above. */
780 while (ISDIGIT (*format
))
783 /* Skip over the dollar sign. */
794 error_char (spec
[n
++].u
.charval
);
798 case 'C': /* Current locus */
799 case 'L': /* Specified locus */
800 error_string (spec
[n
++].u
.stringval
);
805 error_integer (spec
[n
++].u
.intval
);
809 error_uinteger (spec
[n
++].u
.uintval
);
818 error_uinteger (spec
[n
++].u
.ullongintval
);
820 error_integer (spec
[n
++].u
.llongintval
);
823 error_uinteger (spec
[n
++].u
.ulongintval
);
825 error_integer (spec
[n
++].u
.longintval
);
831 error_hwuint (spec
[n
++].u
.hwintval
);
833 error_hwint (spec
[n
++].u
.hwuintval
);
842 /* Wrapper for error_print(). */
845 error_printf (const char *gmsgid
, ...)
849 va_start (argp
, gmsgid
);
850 error_print ("", _(gmsgid
), argp
);
855 /* Clear any output buffered in a pretty-print output_buffer. */
858 gfc_clear_pp_buffer (output_buffer
*this_buffer
)
860 pretty_printer
*pp
= global_dc
->printer
;
861 output_buffer
*tmp_buffer
= pp
->buffer
;
862 pp
->buffer
= this_buffer
;
863 pp_clear_output_area (pp
);
864 pp
->buffer
= tmp_buffer
;
865 /* We need to reset last_location, otherwise we may skip caret lines
866 when we actually give a diagnostic. */
867 global_dc
->last_location
= UNKNOWN_LOCATION
;
870 /* The currently-printing diagnostic, for use by gfc_format_decoder,
871 for colorizing %C and %L. */
873 static diagnostic_info
*curr_diagnostic
;
875 /* A helper function to call diagnostic_report_diagnostic, while setting
876 curr_diagnostic for the duration of the call. */
879 gfc_report_diagnostic (diagnostic_info
*diagnostic
)
881 gcc_assert (diagnostic
!= NULL
);
882 curr_diagnostic
= diagnostic
;
883 bool ret
= diagnostic_report_diagnostic (global_dc
, diagnostic
);
884 curr_diagnostic
= NULL
;
888 /* This is just a helper function to avoid duplicating the logic of
892 gfc_warning (int opt
, const char *gmsgid
, va_list ap
)
897 diagnostic_info diagnostic
;
898 rich_location
rich_loc (line_table
, UNKNOWN_LOCATION
);
899 bool fatal_errors
= global_dc
->fatal_errors
;
900 pretty_printer
*pp
= global_dc
->printer
;
901 output_buffer
*tmp_buffer
= pp
->buffer
;
903 gfc_clear_pp_buffer (pp_warning_buffer
);
907 pp
->buffer
= pp_warning_buffer
;
908 global_dc
->fatal_errors
= false;
909 /* To prevent -fmax-errors= triggering. */
913 diagnostic_set_info (&diagnostic
, gmsgid
, &argp
, &rich_loc
,
915 diagnostic
.option_index
= opt
;
916 bool ret
= gfc_report_diagnostic (&diagnostic
);
920 pp
->buffer
= tmp_buffer
;
921 global_dc
->fatal_errors
= fatal_errors
;
923 warningcount_buffered
= 0;
924 werrorcount_buffered
= 0;
925 /* Undo the above --werrorcount if not Werror, otherwise
926 werrorcount is correct already. */
929 else if (diagnostic
.kind
== DK_ERROR
)
930 ++werrorcount_buffered
;
932 ++werrorcount
, --warningcount
, ++warningcount_buffered
;
939 /* Issue a warning. */
942 gfc_warning (int opt
, const char *gmsgid
, ...)
946 va_start (argp
, gmsgid
);
947 bool ret
= gfc_warning (opt
, gmsgid
, argp
);
953 /* Whether, for a feature included in a given standard set (GFC_STD_*),
954 we should issue an error or a warning, or be quiet. */
957 gfc_notification_std (int std
)
961 warning
= ((gfc_option
.warn_std
& std
) != 0) && !inhibit_warnings
;
962 if ((gfc_option
.allow_std
& std
) != 0 && !warning
)
965 return warning
? WARNING
: ERROR
;
969 /* Return a string describing the nature of a standard violation
970 * and/or the relevant version of the standard. */
973 notify_std_msg(int std
)
976 if (std
& GFC_STD_F2018_DEL
)
977 return _("Fortran 2018 deleted feature:");
978 else if (std
& GFC_STD_F2018_OBS
)
979 return _("Fortran 2018 obsolescent feature:");
980 else if (std
& GFC_STD_F2018
)
981 return _("Fortran 2018:");
982 else if (std
& GFC_STD_F2008_OBS
)
983 return _("Fortran 2008 obsolescent feature:");
984 else if (std
& GFC_STD_F2008
)
985 return "Fortran 2008:";
986 else if (std
& GFC_STD_F2003
)
987 return "Fortran 2003:";
988 else if (std
& GFC_STD_GNU
)
989 return _("GNU Extension:");
990 else if (std
& GFC_STD_LEGACY
)
991 return _("Legacy Extension:");
992 else if (std
& GFC_STD_F95_OBS
)
993 return _("Obsolescent feature:");
994 else if (std
& GFC_STD_F95_DEL
)
995 return _("Deleted feature:");
1001 /* Possibly issue a warning/error about use of a nonstandard (or deleted)
1002 feature. An error/warning will be issued if the currently selected
1003 standard does not contain the requested bits. Return false if
1004 an error is generated. */
1007 gfc_notify_std (int std
, const char *gmsgid
, ...)
1010 const char *msg
, *msg2
;
1013 /* Determine whether an error or a warning is needed. */
1014 const int wstd
= std
& gfc_option
.warn_std
; /* Standard to warn about. */
1015 const int estd
= std
& ~gfc_option
.allow_std
; /* Standard to error about. */
1016 const bool warning
= (wstd
!= 0) && !inhibit_warnings
;
1017 const bool error
= (estd
!= 0);
1019 if (!error
&& !warning
)
1021 if (suppress_errors
)
1025 msg
= notify_std_msg (estd
);
1027 msg
= notify_std_msg (wstd
);
1030 buffer
= (char *) alloca (strlen (msg
) + strlen (msg2
) + 2);
1031 strcpy (buffer
, msg
);
1032 strcat (buffer
, " ");
1033 strcat (buffer
, msg2
);
1035 va_start (argp
, gmsgid
);
1037 gfc_error_opt (0, buffer
, argp
);
1039 gfc_warning (0, buffer
, argp
);
1045 return (warning
&& !warnings_are_errors
);
1049 /* Called from output_format -- during diagnostic message processing
1050 to handle Fortran specific format specifiers with the following meanings:
1052 %C Current locus (no argument)
1053 %L Takes locus argument
1056 gfc_format_decoder (pretty_printer
*pp
, text_info
*text
, const char *spec
,
1057 int precision
, bool wide
, bool set_locus
, bool hash
,
1058 bool *quoted
, const char **buffer_ptr
)
1065 static const char *result
[2] = { "(1)", "(2)" };
1068 loc
= &gfc_current_locus
;
1070 loc
= va_arg (*text
->args_ptr
, locus
*);
1071 gcc_assert (loc
->nextc
- loc
->lb
->line
>= 0);
1072 unsigned int offset
= loc
->nextc
- loc
->lb
->line
;
1073 if (*spec
== 'C' && *loc
->nextc
!= '\0')
1074 /* Point %C first offending character not the last good one. */
1076 /* If location[0] != UNKNOWN_LOCATION means that we already
1077 processed one of %C/%L. */
1078 int loc_num
= text
->get_location (0) == UNKNOWN_LOCATION
? 0 : 1;
1080 = linemap_position_for_loc_and_offset (line_table
,
1083 text
->set_location (loc_num
, src_loc
, SHOW_RANGE_WITH_CARET
);
1084 /* Colorize the markers to match the color choices of
1085 diagnostic_show_locus (the initial location has a color given
1086 by the "kind" of the diagnostic, the secondary location has
1088 gcc_assert (curr_diagnostic
!= NULL
);
1092 : diagnostic_get_color_for_kind (curr_diagnostic
->kind
));
1093 pp_string (pp
, colorize_start (pp_show_color (pp
), color
));
1094 pp_string (pp
, result
[loc_num
]);
1095 pp_string (pp
, colorize_stop (pp_show_color (pp
)));
1099 /* Fall through info the middle-end decoder, as e.g. stor-layout.cc
1100 etc. diagnostics can use the FE printer while the FE is still
1102 return default_tree_printer (pp
, text
, spec
, precision
, wide
,
1103 set_locus
, hash
, quoted
, buffer_ptr
);
1107 /* Return a malloc'd string describing the kind of diagnostic. The
1108 caller is responsible for freeing the memory. */
1110 gfc_diagnostic_build_kind_prefix (diagnostic_context
*context
,
1111 const diagnostic_info
*diagnostic
)
1113 static const char *const diagnostic_kind_text
[] = {
1114 #define DEFINE_DIAGNOSTIC_KIND(K, T, C) (T),
1115 #include "gfc-diagnostic.def"
1116 #undef DEFINE_DIAGNOSTIC_KIND
1119 static const char *const diagnostic_kind_color
[] = {
1120 #define DEFINE_DIAGNOSTIC_KIND(K, T, C) (C),
1121 #include "gfc-diagnostic.def"
1122 #undef DEFINE_DIAGNOSTIC_KIND
1125 gcc_assert (diagnostic
->kind
< DK_LAST_DIAGNOSTIC_KIND
);
1126 const char *text
= _(diagnostic_kind_text
[diagnostic
->kind
]);
1127 const char *text_cs
= "", *text_ce
= "";
1128 pretty_printer
*pp
= context
->printer
;
1130 if (diagnostic_kind_color
[diagnostic
->kind
])
1132 text_cs
= colorize_start (pp_show_color (pp
),
1133 diagnostic_kind_color
[diagnostic
->kind
]);
1134 text_ce
= colorize_stop (pp_show_color (pp
));
1136 return build_message_string ("%s%s:%s ", text_cs
, text
, text_ce
);
1139 /* Return a malloc'd string describing a location. The caller is
1140 responsible for freeing the memory. */
1142 gfc_diagnostic_build_locus_prefix (diagnostic_context
*context
,
1143 expanded_location s
)
1145 pretty_printer
*pp
= context
->printer
;
1146 const char *locus_cs
= colorize_start (pp_show_color (pp
), "locus");
1147 const char *locus_ce
= colorize_stop (pp_show_color (pp
));
1148 return (s
.file
== NULL
1149 ? build_message_string ("%s%s:%s", locus_cs
, progname
, locus_ce
)
1150 : !strcmp (s
.file
, N_("<built-in>"))
1151 ? build_message_string ("%s%s:%s", locus_cs
, s
.file
, locus_ce
)
1152 : context
->show_column
1153 ? build_message_string ("%s%s:%d:%d:%s", locus_cs
, s
.file
, s
.line
,
1155 : build_message_string ("%s%s:%d:%s", locus_cs
, s
.file
, s
.line
, locus_ce
));
1158 /* Return a malloc'd string describing two locations. The caller is
1159 responsible for freeing the memory. */
1161 gfc_diagnostic_build_locus_prefix (diagnostic_context
*context
,
1162 expanded_location s
, expanded_location s2
)
1164 pretty_printer
*pp
= context
->printer
;
1165 const char *locus_cs
= colorize_start (pp_show_color (pp
), "locus");
1166 const char *locus_ce
= colorize_stop (pp_show_color (pp
));
1168 return (s
.file
== NULL
1169 ? build_message_string ("%s%s:%s", locus_cs
, progname
, locus_ce
)
1170 : !strcmp (s
.file
, N_("<built-in>"))
1171 ? build_message_string ("%s%s:%s", locus_cs
, s
.file
, locus_ce
)
1172 : context
->show_column
1173 ? build_message_string ("%s%s:%d:%d-%d:%s", locus_cs
, s
.file
, s
.line
,
1174 MIN (s
.column
, s2
.column
),
1175 MAX (s
.column
, s2
.column
), locus_ce
)
1176 : build_message_string ("%s%s:%d:%s", locus_cs
, s
.file
, s
.line
,
1180 /* This function prints the locus (file:line:column), the diagnostic kind
1181 (Error, Warning) and (optionally) the relevant lines of code with
1182 annotation lines with '1' and/or '2' below them.
1184 With -fdiagnostic-show-caret (the default) it prints:
1186 [locus of primary range]:
1190 Error: Some error at (1)
1192 With -fno-diagnostic-show-caret or if the primary range is not
1195 [locus of primary range]: Error: Some error at (1) and (2)
1198 gfc_diagnostic_starter (diagnostic_context
*context
,
1199 diagnostic_info
*diagnostic
)
1201 char * kind_prefix
= gfc_diagnostic_build_kind_prefix (context
, diagnostic
);
1203 expanded_location s1
= diagnostic_expand_location (diagnostic
);
1204 expanded_location s2
;
1205 bool one_locus
= diagnostic
->richloc
->get_num_locations () < 2;
1206 bool same_locus
= false;
1210 s2
= diagnostic_expand_location (diagnostic
, 1);
1211 same_locus
= diagnostic_same_line (context
, s1
, s2
);
1214 char * locus_prefix
= (one_locus
|| !same_locus
)
1215 ? gfc_diagnostic_build_locus_prefix (context
, s1
)
1216 : gfc_diagnostic_build_locus_prefix (context
, s1
, s2
);
1218 if (!context
->show_caret
1219 || diagnostic_location (diagnostic
, 0) <= BUILTINS_LOCATION
1220 || diagnostic_location (diagnostic
, 0) == context
->last_location
)
1222 pp_set_prefix (context
->printer
,
1223 concat (locus_prefix
, " ", kind_prefix
, NULL
));
1224 free (locus_prefix
);
1226 if (one_locus
|| same_locus
)
1231 /* In this case, we print the previous locus and prefix as:
1233 [locus]:[prefix]: (1)
1235 and we flush with a new line before setting the new prefix. */
1236 pp_string (context
->printer
, "(1)");
1237 pp_newline (context
->printer
);
1238 locus_prefix
= gfc_diagnostic_build_locus_prefix (context
, s2
);
1239 pp_set_prefix (context
->printer
,
1240 concat (locus_prefix
, " ", kind_prefix
, NULL
));
1242 free (locus_prefix
);
1246 pp_verbatim (context
->printer
, "%s", locus_prefix
);
1247 free (locus_prefix
);
1248 /* Fortran uses an empty line between locus and caret line. */
1249 pp_newline (context
->printer
);
1250 pp_set_prefix (context
->printer
, NULL
);
1251 pp_newline (context
->printer
);
1252 diagnostic_show_locus (context
, diagnostic
->richloc
, diagnostic
->kind
);
1253 /* If the caret line was shown, the prefix does not contain the
1255 pp_set_prefix (context
->printer
, kind_prefix
);
1260 gfc_diagnostic_start_span (diagnostic_context
*context
,
1261 expanded_location exploc
)
1264 locus_prefix
= gfc_diagnostic_build_locus_prefix (context
, exploc
);
1265 pp_verbatim (context
->printer
, "%s", locus_prefix
);
1266 free (locus_prefix
);
1267 pp_newline (context
->printer
);
1268 /* Fortran uses an empty line between locus and caret line. */
1269 pp_newline (context
->printer
);
1274 gfc_diagnostic_finalizer (diagnostic_context
*context
,
1275 diagnostic_info
*diagnostic ATTRIBUTE_UNUSED
,
1276 diagnostic_t orig_diag_kind ATTRIBUTE_UNUSED
)
1278 pp_destroy_prefix (context
->printer
);
1279 pp_newline_and_flush (context
->printer
);
1282 /* Immediate warning (i.e. do not buffer the warning) with an explicit
1286 gfc_warning_now_at (location_t loc
, int opt
, const char *gmsgid
, ...)
1289 diagnostic_info diagnostic
;
1290 rich_location
rich_loc (line_table
, loc
);
1293 va_start (argp
, gmsgid
);
1294 diagnostic_set_info (&diagnostic
, gmsgid
, &argp
, &rich_loc
, DK_WARNING
);
1295 diagnostic
.option_index
= opt
;
1296 ret
= gfc_report_diagnostic (&diagnostic
);
1301 /* Immediate warning (i.e. do not buffer the warning). */
1304 gfc_warning_now (int opt
, const char *gmsgid
, ...)
1307 diagnostic_info diagnostic
;
1308 rich_location
rich_loc (line_table
, UNKNOWN_LOCATION
);
1311 va_start (argp
, gmsgid
);
1312 diagnostic_set_info (&diagnostic
, gmsgid
, &argp
, &rich_loc
,
1314 diagnostic
.option_index
= opt
;
1315 ret
= gfc_report_diagnostic (&diagnostic
);
1320 /* Internal warning, do not buffer. */
1323 gfc_warning_internal (int opt
, const char *gmsgid
, ...)
1326 diagnostic_info diagnostic
;
1327 rich_location
rich_loc (line_table
, UNKNOWN_LOCATION
);
1330 va_start (argp
, gmsgid
);
1331 diagnostic_set_info (&diagnostic
, gmsgid
, &argp
, &rich_loc
,
1333 diagnostic
.option_index
= opt
;
1334 ret
= gfc_report_diagnostic (&diagnostic
);
1339 /* Immediate error (i.e. do not buffer). */
1342 gfc_error_now (const char *gmsgid
, ...)
1345 diagnostic_info diagnostic
;
1346 rich_location
rich_loc (line_table
, UNKNOWN_LOCATION
);
1348 error_buffer
.flag
= true;
1350 va_start (argp
, gmsgid
);
1351 diagnostic_set_info (&diagnostic
, gmsgid
, &argp
, &rich_loc
, DK_ERROR
);
1352 gfc_report_diagnostic (&diagnostic
);
1357 /* Fatal error, never returns. */
1360 gfc_fatal_error (const char *gmsgid
, ...)
1363 diagnostic_info diagnostic
;
1364 rich_location
rich_loc (line_table
, UNKNOWN_LOCATION
);
1366 va_start (argp
, gmsgid
);
1367 diagnostic_set_info (&diagnostic
, gmsgid
, &argp
, &rich_loc
, DK_FATAL
);
1368 gfc_report_diagnostic (&diagnostic
);
1374 /* Clear the warning flag. */
1377 gfc_clear_warning (void)
1379 gfc_clear_pp_buffer (pp_warning_buffer
);
1380 warningcount_buffered
= 0;
1381 werrorcount_buffered
= 0;
1385 /* Check to see if any warnings have been saved.
1386 If so, print the warning. */
1389 gfc_warning_check (void)
1391 if (! gfc_output_buffer_empty_p (pp_warning_buffer
))
1393 pretty_printer
*pp
= global_dc
->printer
;
1394 output_buffer
*tmp_buffer
= pp
->buffer
;
1395 pp
->buffer
= pp_warning_buffer
;
1396 pp_really_flush (pp
);
1397 warningcount
+= warningcount_buffered
;
1398 werrorcount
+= werrorcount_buffered
;
1399 gcc_assert (warningcount_buffered
+ werrorcount_buffered
== 1);
1400 pp
->buffer
= tmp_buffer
;
1401 diagnostic_action_after_output (global_dc
,
1402 warningcount_buffered
1403 ? DK_WARNING
: DK_ERROR
);
1404 diagnostic_check_max_errors (global_dc
, true);
1409 /* Issue an error. */
1412 gfc_error_opt (int opt
, const char *gmsgid
, va_list ap
)
1416 bool saved_abort_on_error
= false;
1418 if (warnings_not_errors
)
1420 gfc_warning (opt
, gmsgid
, argp
);
1425 if (suppress_errors
)
1431 diagnostic_info diagnostic
;
1432 rich_location
richloc (line_table
, UNKNOWN_LOCATION
);
1433 bool fatal_errors
= global_dc
->fatal_errors
;
1434 pretty_printer
*pp
= global_dc
->printer
;
1435 output_buffer
*tmp_buffer
= pp
->buffer
;
1437 gfc_clear_pp_buffer (pp_error_buffer
);
1441 /* To prevent -dH from triggering an abort on a buffered error,
1442 save abort_on_error and restore it below. */
1443 saved_abort_on_error
= global_dc
->abort_on_error
;
1444 global_dc
->abort_on_error
= false;
1445 pp
->buffer
= pp_error_buffer
;
1446 global_dc
->fatal_errors
= false;
1447 /* To prevent -fmax-errors= triggering, we decrease it before
1448 report_diagnostic increases it. */
1452 diagnostic_set_info (&diagnostic
, gmsgid
, &argp
, &richloc
, DK_ERROR
);
1453 gfc_report_diagnostic (&diagnostic
);
1457 pp
->buffer
= tmp_buffer
;
1458 global_dc
->fatal_errors
= fatal_errors
;
1459 global_dc
->abort_on_error
= saved_abort_on_error
;
1468 gfc_error_opt (int opt
, const char *gmsgid
, ...)
1471 va_start (argp
, gmsgid
);
1472 gfc_error_opt (opt
, gmsgid
, argp
);
1478 gfc_error (const char *gmsgid
, ...)
1481 va_start (argp
, gmsgid
);
1482 gfc_error_opt (0, gmsgid
, argp
);
1487 /* This shouldn't happen... but sometimes does. */
1490 gfc_internal_error (const char *gmsgid
, ...)
1494 diagnostic_info diagnostic
;
1495 rich_location
rich_loc (line_table
, UNKNOWN_LOCATION
);
1497 gfc_get_errors (&w
, &e
);
1501 va_start (argp
, gmsgid
);
1502 diagnostic_set_info (&diagnostic
, gmsgid
, &argp
, &rich_loc
, DK_ICE
);
1503 gfc_report_diagnostic (&diagnostic
);
1510 /* Clear the error flag when we start to compile a source line. */
1513 gfc_clear_error (void)
1515 error_buffer
.flag
= false;
1516 warnings_not_errors
= false;
1517 gfc_clear_pp_buffer (pp_error_buffer
);
1521 /* Tests the state of error_flag. */
1524 gfc_error_flag_test (void)
1526 return error_buffer
.flag
1527 || !gfc_output_buffer_empty_p (pp_error_buffer
);
1531 /* Check to see if any errors have been saved.
1532 If so, print the error. Returns the state of error_flag. */
1535 gfc_error_check (void)
1537 if (error_buffer
.flag
1538 || ! gfc_output_buffer_empty_p (pp_error_buffer
))
1540 error_buffer
.flag
= false;
1541 pretty_printer
*pp
= global_dc
->printer
;
1542 output_buffer
*tmp_buffer
= pp
->buffer
;
1543 pp
->buffer
= pp_error_buffer
;
1544 pp_really_flush (pp
);
1546 gcc_assert (gfc_output_buffer_empty_p (pp_error_buffer
));
1547 pp
->buffer
= tmp_buffer
;
1548 diagnostic_action_after_output (global_dc
, DK_ERROR
);
1549 diagnostic_check_max_errors (global_dc
, true);
1556 /* Move the text buffered from FROM to TO, then clear
1557 FROM. Independently if there was text in FROM, TO is also
1561 gfc_move_error_buffer_from_to (gfc_error_buffer
* buffer_from
,
1562 gfc_error_buffer
* buffer_to
)
1564 output_buffer
* from
= &(buffer_from
->buffer
);
1565 output_buffer
* to
= &(buffer_to
->buffer
);
1567 buffer_to
->flag
= buffer_from
->flag
;
1568 buffer_from
->flag
= false;
1570 gfc_clear_pp_buffer (to
);
1571 /* We make sure this is always buffered. */
1572 to
->flush_p
= false;
1574 if (! gfc_output_buffer_empty_p (from
))
1576 const char *str
= output_buffer_formatted_text (from
);
1577 output_buffer_append_r (to
, str
, strlen (str
));
1578 gfc_clear_pp_buffer (from
);
1582 /* Save the existing error state. */
1585 gfc_push_error (gfc_error_buffer
*err
)
1587 gfc_move_error_buffer_from_to (&error_buffer
, err
);
1591 /* Restore a previous pushed error state. */
1594 gfc_pop_error (gfc_error_buffer
*err
)
1596 gfc_move_error_buffer_from_to (err
, &error_buffer
);
1600 /* Free a pushed error state, but keep the current error state. */
1603 gfc_free_error (gfc_error_buffer
*err
)
1605 gfc_clear_pp_buffer (&(err
->buffer
));
1609 /* Report the number of warnings and errors that occurred to the caller. */
1612 gfc_get_errors (int *w
, int *e
)
1615 *w
= warningcount
+ werrorcount
;
1617 *e
= errorcount
+ sorrycount
+ werrorcount
;
1621 /* Switch errors into warnings. */
1624 gfc_errors_to_warnings (bool f
)
1626 warnings_not_errors
= f
;
1630 gfc_diagnostics_init (void)
1632 diagnostic_starter (global_dc
) = gfc_diagnostic_starter
;
1633 global_dc
->start_span
= gfc_diagnostic_start_span
;
1634 diagnostic_finalizer (global_dc
) = gfc_diagnostic_finalizer
;
1635 diagnostic_format_decoder (global_dc
) = gfc_format_decoder
;
1636 global_dc
->caret_chars
[0] = '1';
1637 global_dc
->caret_chars
[1] = '2';
1638 pp_warning_buffer
= new (XNEW (output_buffer
)) output_buffer ();
1639 pp_warning_buffer
->flush_p
= false;
1640 /* pp_error_buffer is statically allocated. This simplifies memory
1641 management when using gfc_push/pop_error. */
1642 pp_error_buffer
= &(error_buffer
.buffer
);
1643 pp_error_buffer
->flush_p
= false;
1647 gfc_diagnostics_finish (void)
1649 tree_diagnostics_defaults (global_dc
);
1650 /* We still want to use the gfc starter and finalizer, not the tree
1652 diagnostic_starter (global_dc
) = gfc_diagnostic_starter
;
1653 diagnostic_finalizer (global_dc
) = gfc_diagnostic_finalizer
;
1654 global_dc
->caret_chars
[0] = '^';
1655 global_dc
->caret_chars
[1] = '^';