2 Copyright (C) 2000-2015 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 #include <new> /* For placement-new */
39 static int suppress_errors
= 0;
41 static bool warnings_not_errors
= false;
43 static int terminal_width
;
45 /* True if the error/warnings should be buffered. */
46 static bool buffered_p
;
48 static gfc_error_buffer error_buffer
;
49 /* These are always buffered buffers (.flush_p == false) to be used by
50 the pretty-printer. */
51 static output_buffer
*pp_error_buffer
, *pp_warning_buffer
;
52 static int warningcount_buffered
, werrorcount_buffered
;
54 /* Return true if there output_buffer is empty. */
57 gfc_output_buffer_empty_p (const output_buffer
* buf
)
59 return output_buffer_last_position_in_text (buf
) == NULL
;
62 /* Go one level deeper suppressing errors. */
65 gfc_push_suppress_errors (void)
67 gcc_assert (suppress_errors
>= 0);
72 gfc_error (const char *gmsgid
, va_list ap
) ATTRIBUTE_GCC_GFC(1,0);
75 gfc_warning (int opt
, const char *gmsgid
, va_list ap
) ATTRIBUTE_GCC_GFC(2,0);
78 /* Leave one level of error suppressing. */
81 gfc_pop_suppress_errors (void)
83 gcc_assert (suppress_errors
> 0);
88 /* Determine terminal width (for trimming source lines in output). */
91 gfc_get_terminal_width (void)
93 return isatty (STDERR_FILENO
) ? get_terminal_width () : INT_MAX
;
97 /* Per-file error initialization. */
100 gfc_error_init_1 (void)
102 terminal_width
= gfc_get_terminal_width ();
103 gfc_buffer_error (false);
107 /* Set the flag for buffering errors or not. */
110 gfc_buffer_error (bool flag
)
116 /* Add a single character to the error buffer or output depending on
122 /* FIXME: Unused function to be removed in a subsequent patch. */
126 /* Copy a string to wherever it needs to go. */
129 error_string (const char *p
)
136 /* Print a formatted integer to the error buffer or output. */
141 error_uinteger (unsigned long int i
)
143 char *p
, int_buf
[IBUF_LEN
];
145 p
= int_buf
+ IBUF_LEN
- 1;
157 error_string (p
+ 1);
161 error_integer (long int i
)
167 u
= (unsigned long int) -i
;
178 gfc_widechar_display_length (gfc_char_t c
)
180 if (gfc_wide_is_printable (c
) || c
== '\t')
181 /* Printable ASCII character, or tabulation (output as a space). */
183 else if (c
< ((gfc_char_t
) 1 << 8))
184 /* Displayed as \x?? */
186 else if (c
< ((gfc_char_t
) 1 << 16))
187 /* Displayed as \u???? */
190 /* Displayed as \U???????? */
195 /* Length of the ASCII representation of the wide string, escaping wide
196 characters as print_wide_char_into_buffer() does. */
199 gfc_wide_display_length (const gfc_char_t
*str
)
203 for (i
= 0, len
= 0; str
[i
]; i
++)
204 len
+= gfc_widechar_display_length (str
[i
]);
210 print_wide_char_into_buffer (gfc_char_t c
, char *buf
)
212 static const char xdigit
[16] = { '0', '1', '2', '3', '4', '5', '6',
213 '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F' };
215 if (gfc_wide_is_printable (c
) || c
== '\t')
218 /* Tabulation is output as a space. */
219 buf
[0] = (unsigned char) (c
== '\t' ? ' ' : c
);
222 else if (c
< ((gfc_char_t
) 1 << 8))
225 buf
[3] = xdigit
[c
& 0x0F];
227 buf
[2] = xdigit
[c
& 0x0F];
233 else if (c
< ((gfc_char_t
) 1 << 16))
236 buf
[5] = xdigit
[c
& 0x0F];
238 buf
[4] = xdigit
[c
& 0x0F];
240 buf
[3] = xdigit
[c
& 0x0F];
242 buf
[2] = xdigit
[c
& 0x0F];
251 buf
[9] = xdigit
[c
& 0x0F];
253 buf
[8] = xdigit
[c
& 0x0F];
255 buf
[7] = xdigit
[c
& 0x0F];
257 buf
[6] = xdigit
[c
& 0x0F];
259 buf
[5] = xdigit
[c
& 0x0F];
261 buf
[4] = xdigit
[c
& 0x0F];
263 buf
[3] = xdigit
[c
& 0x0F];
265 buf
[2] = xdigit
[c
& 0x0F];
273 static char wide_char_print_buffer
[11];
276 gfc_print_wide_char (gfc_char_t c
)
278 print_wide_char_into_buffer (c
, wide_char_print_buffer
);
279 return wide_char_print_buffer
;
283 /* Show the file, where it was included, and the source line, give a
284 locus. Calls error_printf() recursively, but the recursion is at
285 most one level deep. */
287 static void error_printf (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
290 show_locus (locus
*loc
, int c1
, int c2
)
297 /* TODO: Either limit the total length and number of included files
298 displayed or add buffering of arbitrary number of characters in
301 /* Write out the error header line, giving the source file and error
302 location (in GNU standard "[file]:[line].[column]:" format),
303 followed by an "included by" stack and a blank line. This header
304 format is matched by a testsuite parser defined in
305 lib/gfortran-dg.exp. */
310 error_string (f
->filename
);
313 error_integer (LOCATION_LINE (lb
->location
));
315 if ((c1
> 0) || (c2
> 0))
321 if ((c1
> 0) && (c2
> 0))
332 i
= f
->inclusion_line
;
335 if (f
== NULL
) break;
337 error_printf (" Included at %s:%d:", f
->filename
, i
);
342 /* Calculate an appropriate horizontal offset of the source line in
343 order to get the error locus within the visible portion of the
344 line. Note that if the margin of 5 here is changed, the
345 corresponding margin of 10 in show_loci should be changed. */
349 /* If the two loci would appear in the same column, we shift
350 '2' one column to the right, so as to print '12' rather than
351 just '1'. We do this here so it will be accounted for in the
352 margin calculations. */
357 cmax
= (c1
< c2
) ? c2
: c1
;
358 if (cmax
> terminal_width
- 5)
359 offset
= cmax
- terminal_width
+ 5;
361 /* Show the line itself, taking care not to print more than what can
362 show up on the terminal. Tabs are converted to spaces, and
363 nonprintable characters are converted to a "\xNN" sequence. */
365 p
= &(lb
->line
[offset
]);
366 i
= gfc_wide_display_length (p
);
367 if (i
> terminal_width
)
368 i
= terminal_width
- 1;
372 static char buffer
[11];
373 i
-= print_wide_char_into_buffer (*p
++, buffer
);
374 error_string (buffer
);
379 /* Show the '1' and/or '2' corresponding to the column of the error
380 locus. Note that a value of -1 for c1 or c2 will simply cause
381 the relevant number not to be printed. */
387 p
= &(lb
->line
[offset
]);
388 for (i
= 0; i
< cmax
; i
++)
391 spaces
= gfc_widechar_display_length (*p
++);
394 error_char ('1'), spaces
--;
396 error_char ('2'), spaces
--;
398 for (j
= 0; j
< spaces
; j
++)
412 /* As part of printing an error, we show the source lines that caused
413 the problem. We show at least one, and possibly two loci; the two
414 loci may or may not be on the same source line. */
417 show_loci (locus
*l1
, locus
*l2
)
421 if (l1
== NULL
|| l1
->lb
== NULL
)
423 error_printf ("<During initialization>\n");
427 /* While calculating parameters for printing the loci, we consider possible
428 reasons for printing one per line. If appropriate, print the loci
429 individually; otherwise we print them both on the same line. */
431 c1
= l1
->nextc
- l1
->lb
->line
;
434 show_locus (l1
, c1
, -1);
438 c2
= l2
->nextc
- l2
->lb
->line
;
445 /* Note that the margin value of 10 here needs to be less than the
446 margin of 5 used in the calculation of offset in show_locus. */
448 if (l1
->lb
!= l2
->lb
|| m
> terminal_width
- 10)
450 show_locus (l1
, c1
, -1);
451 show_locus (l2
, -1, c2
);
455 show_locus (l1
, c1
, c2
);
461 /* Workhorse for the error printing subroutines. This subroutine is
462 inspired by g77's error handling and is similar to printf() with
463 the following %-codes:
465 %c Character, %d or %i Integer, %s String, %% Percent
466 %L Takes locus argument
467 %C Current locus (no argument)
469 If a locus pointer is given, the actual source line is printed out
470 and the column is indicated. Since we want the error message at
471 the bottom of any source file information, we must scan the
472 argument list twice -- once to determine whether the loci are
473 present and record this for printing, and once to print the error
474 message after and loci have been printed. A maximum of two locus
475 arguments are permitted.
477 This function is also called (recursively) by show_locus in the
478 case of included files; however, as show_locus does not resupply
479 any loci, the recursion is at most one level deep. */
483 static void ATTRIBUTE_GCC_GFC(2,0)
484 error_print (const char *type
, const char *format0
, va_list argp
)
486 enum { TYPE_CURRENTLOC
, TYPE_LOCUS
, TYPE_INTEGER
, TYPE_UINTEGER
,
487 TYPE_LONGINT
, TYPE_ULONGINT
, TYPE_CHAR
, TYPE_STRING
,
496 unsigned int uintval
;
498 unsigned long int ulongintval
;
500 const char * stringval
;
502 } arg
[MAX_ARGS
], spec
[MAX_ARGS
];
503 /* spec is the array of specifiers, in the same order as they
504 appear in the format string. arg is the array of arguments,
505 in the same order as they appear in the va_list. */
508 int i
, n
, have_l1
, pos
, maxpos
;
509 locus
*l1
, *l2
, *loc
;
512 loc
= l1
= l2
= NULL
;
521 for (i
= 0; i
< MAX_ARGS
; i
++)
523 arg
[i
].type
= NOTYPE
;
527 /* First parse the format string for position specifiers. */
540 if (ISDIGIT (*format
))
542 /* This is a position specifier. For example, the number
543 12 in the format string "%12$d", which specifies the third
544 argument of the va_list, formatted in %d format.
545 For details, see "man 3 printf". */
546 pos
= atoi(format
) - 1;
547 gcc_assert (pos
>= 0);
548 while (ISDIGIT(*format
))
550 gcc_assert (*format
== '$');
564 arg
[pos
].type
= TYPE_CURRENTLOC
;
568 arg
[pos
].type
= TYPE_LOCUS
;
573 arg
[pos
].type
= TYPE_INTEGER
;
577 arg
[pos
].type
= TYPE_UINTEGER
;
583 arg
[pos
].type
= TYPE_ULONGINT
;
584 else if (c
== 'i' || c
== 'd')
585 arg
[pos
].type
= TYPE_LONGINT
;
591 arg
[pos
].type
= TYPE_CHAR
;
595 arg
[pos
].type
= TYPE_STRING
;
605 /* Then convert the values for each %-style argument. */
606 for (pos
= 0; pos
<= maxpos
; pos
++)
608 gcc_assert (arg
[pos
].type
!= NOTYPE
);
609 switch (arg
[pos
].type
)
611 case TYPE_CURRENTLOC
:
612 loc
= &gfc_current_locus
;
616 if (arg
[pos
].type
== TYPE_LOCUS
)
617 loc
= va_arg (argp
, locus
*);
622 arg
[pos
].u
.stringval
= "(2)";
628 arg
[pos
].u
.stringval
= "(1)";
633 arg
[pos
].u
.intval
= va_arg (argp
, int);
637 arg
[pos
].u
.uintval
= va_arg (argp
, unsigned int);
641 arg
[pos
].u
.longintval
= va_arg (argp
, long int);
645 arg
[pos
].u
.ulongintval
= va_arg (argp
, unsigned long int);
649 arg
[pos
].u
.charval
= (char) va_arg (argp
, int);
653 arg
[pos
].u
.stringval
= (const char *) va_arg (argp
, char *);
661 for (n
= 0; spec
[n
].pos
>= 0; n
++)
662 spec
[n
].u
= arg
[spec
[n
].pos
].u
;
664 /* Show the current loci if we have to. */
678 for (; *format
; format
++)
682 error_char (*format
);
687 if (ISDIGIT (*format
))
689 /* This is a position specifier. See comment above. */
690 while (ISDIGIT (*format
))
693 /* Skip over the dollar sign. */
704 error_char (spec
[n
++].u
.charval
);
708 case 'C': /* Current locus */
709 case 'L': /* Specified locus */
710 error_string (spec
[n
++].u
.stringval
);
715 error_integer (spec
[n
++].u
.intval
);
719 error_uinteger (spec
[n
++].u
.uintval
);
725 error_uinteger (spec
[n
++].u
.ulongintval
);
727 error_integer (spec
[n
++].u
.longintval
);
737 /* Wrapper for error_print(). */
740 error_printf (const char *gmsgid
, ...)
744 va_start (argp
, gmsgid
);
745 error_print ("", _(gmsgid
), argp
);
750 /* Clear any output buffered in a pretty-print output_buffer. */
753 gfc_clear_pp_buffer (output_buffer
*this_buffer
)
755 pretty_printer
*pp
= global_dc
->printer
;
756 output_buffer
*tmp_buffer
= pp
->buffer
;
757 pp
->buffer
= this_buffer
;
758 pp_clear_output_area (pp
);
759 pp
->buffer
= tmp_buffer
;
760 /* We need to reset last_location, otherwise we may skip caret lines
761 when we actually give a diagnostic. */
762 global_dc
->last_location
= UNKNOWN_LOCATION
;
766 /* This is just a helper function to avoid duplicating the logic of
770 gfc_warning (int opt
, const char *gmsgid
, va_list ap
)
775 diagnostic_info diagnostic
;
776 rich_location
rich_loc (line_table
, UNKNOWN_LOCATION
);
777 bool fatal_errors
= global_dc
->fatal_errors
;
778 pretty_printer
*pp
= global_dc
->printer
;
779 output_buffer
*tmp_buffer
= pp
->buffer
;
781 gfc_clear_pp_buffer (pp_warning_buffer
);
785 pp
->buffer
= pp_warning_buffer
;
786 global_dc
->fatal_errors
= false;
787 /* To prevent -fmax-errors= triggering. */
791 diagnostic_set_info (&diagnostic
, gmsgid
, &argp
, &rich_loc
,
793 diagnostic
.option_index
= opt
;
794 bool ret
= report_diagnostic (&diagnostic
);
798 pp
->buffer
= tmp_buffer
;
799 global_dc
->fatal_errors
= fatal_errors
;
801 warningcount_buffered
= 0;
802 werrorcount_buffered
= 0;
803 /* Undo the above --werrorcount if not Werror, otherwise
804 werrorcount is correct already. */
807 else if (diagnostic
.kind
== DK_ERROR
)
808 ++werrorcount_buffered
;
810 ++werrorcount
, --warningcount
, ++warningcount_buffered
;
817 /* Issue a warning. */
820 gfc_warning (int opt
, const char *gmsgid
, ...)
824 va_start (argp
, gmsgid
);
825 bool ret
= gfc_warning (opt
, gmsgid
, argp
);
831 /* Whether, for a feature included in a given standard set (GFC_STD_*),
832 we should issue an error or a warning, or be quiet. */
835 gfc_notification_std (int std
)
839 warning
= ((gfc_option
.warn_std
& std
) != 0) && !inhibit_warnings
;
840 if ((gfc_option
.allow_std
& std
) != 0 && !warning
)
843 return warning
? WARNING
: ERROR
;
847 /* Possibly issue a warning/error about use of a nonstandard (or deleted)
848 feature. An error/warning will be issued if the currently selected
849 standard does not contain the requested bits. Return false if
850 an error is generated. */
853 gfc_notify_std (int std
, const char *gmsgid
, ...)
857 const char *msg
, *msg2
;
860 warning
= ((gfc_option
.warn_std
& std
) != 0) && !inhibit_warnings
;
861 if ((gfc_option
.allow_std
& std
) != 0 && !warning
)
865 return warning
? true : false;
869 case GFC_STD_F2008_TS
:
870 msg
= "TS 29113/TS 18508:";
872 case GFC_STD_F2008_OBS
:
873 msg
= _("Fortran 2008 obsolescent feature:");
876 msg
= "Fortran 2008:";
879 msg
= "Fortran 2003:";
882 msg
= _("GNU Extension:");
885 msg
= _("Legacy Extension:");
887 case GFC_STD_F95_OBS
:
888 msg
= _("Obsolescent feature:");
890 case GFC_STD_F95_DEL
:
891 msg
= _("Deleted feature:");
898 buffer
= (char *) alloca (strlen (msg
) + strlen (msg2
) + 2);
899 strcpy (buffer
, msg
);
900 strcat (buffer
, " ");
901 strcat (buffer
, msg2
);
903 va_start (argp
, gmsgid
);
905 gfc_warning (0, buffer
, argp
);
907 gfc_error (buffer
, argp
);
910 return (warning
&& !warnings_are_errors
) ? true : false;
914 /* Called from output_format -- during diagnostic message processing
915 to handle Fortran specific format specifiers with the following meanings:
917 %C Current locus (no argument)
918 %L Takes locus argument
921 gfc_format_decoder (pretty_printer
*pp
,
922 text_info
*text
, const char *spec
,
923 int precision ATTRIBUTE_UNUSED
, bool wide ATTRIBUTE_UNUSED
,
924 bool plus ATTRIBUTE_UNUSED
, bool hash ATTRIBUTE_UNUSED
)
931 static const char *result
[2] = { "(1)", "(2)" };
934 loc
= &gfc_current_locus
;
936 loc
= va_arg (*text
->args_ptr
, locus
*);
937 gcc_assert (loc
->nextc
- loc
->lb
->line
>= 0);
938 unsigned int offset
= loc
->nextc
- loc
->lb
->line
;
939 /* If location[0] != UNKNOWN_LOCATION means that we already
940 processed one of %C/%L. */
941 int loc_num
= text
->get_location (0) == UNKNOWN_LOCATION
? 0 : 1;
943 = linemap_position_for_loc_and_offset (line_table
,
946 text
->set_location (loc_num
, src_loc
, true);
947 pp_string (pp
, result
[loc_num
]);
955 /* Return a malloc'd string describing the kind of diagnostic. The
956 caller is responsible for freeing the memory. */
958 gfc_diagnostic_build_kind_prefix (diagnostic_context
*context
,
959 const diagnostic_info
*diagnostic
)
961 static const char *const diagnostic_kind_text
[] = {
962 #define DEFINE_DIAGNOSTIC_KIND(K, T, C) (T),
963 #include "gfc-diagnostic.def"
964 #undef DEFINE_DIAGNOSTIC_KIND
967 static const char *const diagnostic_kind_color
[] = {
968 #define DEFINE_DIAGNOSTIC_KIND(K, T, C) (C),
969 #include "gfc-diagnostic.def"
970 #undef DEFINE_DIAGNOSTIC_KIND
973 gcc_assert (diagnostic
->kind
< DK_LAST_DIAGNOSTIC_KIND
);
974 const char *text
= _(diagnostic_kind_text
[diagnostic
->kind
]);
975 const char *text_cs
= "", *text_ce
= "";
976 pretty_printer
*pp
= context
->printer
;
978 if (diagnostic_kind_color
[diagnostic
->kind
])
980 text_cs
= colorize_start (pp_show_color (pp
),
981 diagnostic_kind_color
[diagnostic
->kind
]);
982 text_ce
= colorize_stop (pp_show_color (pp
));
984 return build_message_string ("%s%s:%s ", text_cs
, text
, text_ce
);
987 /* Return a malloc'd string describing a location. The caller is
988 responsible for freeing the memory. */
990 gfc_diagnostic_build_locus_prefix (diagnostic_context
*context
,
993 pretty_printer
*pp
= context
->printer
;
994 const char *locus_cs
= colorize_start (pp_show_color (pp
), "locus");
995 const char *locus_ce
= colorize_stop (pp_show_color (pp
));
996 return (s
.file
== NULL
997 ? build_message_string ("%s%s:%s", locus_cs
, progname
, locus_ce
)
998 : !strcmp (s
.file
, N_("<built-in>"))
999 ? build_message_string ("%s%s:%s", locus_cs
, s
.file
, locus_ce
)
1000 : context
->show_column
1001 ? build_message_string ("%s%s:%d:%d:%s", locus_cs
, s
.file
, s
.line
,
1003 : build_message_string ("%s%s:%d:%s", locus_cs
, s
.file
, s
.line
, locus_ce
));
1006 /* Return a malloc'd string describing two locations. The caller is
1007 responsible for freeing the memory. */
1009 gfc_diagnostic_build_locus_prefix (diagnostic_context
*context
,
1010 expanded_location s
, expanded_location s2
)
1012 pretty_printer
*pp
= context
->printer
;
1013 const char *locus_cs
= colorize_start (pp_show_color (pp
), "locus");
1014 const char *locus_ce
= colorize_stop (pp_show_color (pp
));
1016 return (s
.file
== NULL
1017 ? build_message_string ("%s%s:%s", locus_cs
, progname
, locus_ce
)
1018 : !strcmp (s
.file
, N_("<built-in>"))
1019 ? build_message_string ("%s%s:%s", locus_cs
, s
.file
, locus_ce
)
1020 : context
->show_column
1021 ? build_message_string ("%s%s:%d:%d-%d:%s", locus_cs
, s
.file
, s
.line
,
1022 MIN (s
.column
, s2
.column
),
1023 MAX (s
.column
, s2
.column
), locus_ce
)
1024 : build_message_string ("%s%s:%d:%s", locus_cs
, s
.file
, s
.line
,
1028 /* This function prints the locus (file:line:column), the diagnostic kind
1029 (Error, Warning) and (optionally) the relevant lines of code with
1030 annotation lines with '1' and/or '2' below them.
1032 With -fdiagnostic-show-caret (the default) it prints:
1034 [locus of primary range]:
1038 Error: Some error at (1)
1040 With -fno-diagnostic-show-caret or if the primary range is not
1043 [locus of primary range]: Error: Some error at (1) and (2)
1046 gfc_diagnostic_starter (diagnostic_context
*context
,
1047 diagnostic_info
*diagnostic
)
1049 char * kind_prefix
= gfc_diagnostic_build_kind_prefix (context
, diagnostic
);
1051 expanded_location s1
= diagnostic_expand_location (diagnostic
);
1052 expanded_location s2
;
1053 bool one_locus
= diagnostic
->richloc
->get_num_locations () < 2;
1054 bool same_locus
= false;
1058 s2
= diagnostic_expand_location (diagnostic
, 1);
1059 same_locus
= diagnostic_same_line (context
, s1
, s2
);
1062 char * locus_prefix
= (one_locus
|| !same_locus
)
1063 ? gfc_diagnostic_build_locus_prefix (context
, s1
)
1064 : gfc_diagnostic_build_locus_prefix (context
, s1
, s2
);
1066 if (!context
->show_caret
1067 || diagnostic_location (diagnostic
, 0) <= BUILTINS_LOCATION
1068 || diagnostic_location (diagnostic
, 0) == context
->last_location
)
1070 pp_set_prefix (context
->printer
,
1071 concat (locus_prefix
, " ", kind_prefix
, NULL
));
1072 free (locus_prefix
);
1074 if (one_locus
|| same_locus
)
1079 /* In this case, we print the previous locus and prefix as:
1081 [locus]:[prefix]: (1)
1083 and we flush with a new line before setting the new prefix. */
1084 pp_string (context
->printer
, "(1)");
1085 pp_newline (context
->printer
);
1086 locus_prefix
= gfc_diagnostic_build_locus_prefix (context
, s2
);
1087 pp_set_prefix (context
->printer
,
1088 concat (locus_prefix
, " ", kind_prefix
, NULL
));
1090 free (locus_prefix
);
1094 pp_verbatim (context
->printer
, locus_prefix
);
1095 free (locus_prefix
);
1096 /* Fortran uses an empty line between locus and caret line. */
1097 pp_newline (context
->printer
);
1098 diagnostic_show_locus (context
, diagnostic
);
1099 pp_newline (context
->printer
);
1100 /* If the caret line was shown, the prefix does not contain the
1102 pp_set_prefix (context
->printer
, kind_prefix
);
1107 gfc_diagnostic_finalizer (diagnostic_context
*context
,
1108 diagnostic_info
*diagnostic ATTRIBUTE_UNUSED
)
1110 pp_destroy_prefix (context
->printer
);
1111 pp_newline_and_flush (context
->printer
);
1114 /* Immediate warning (i.e. do not buffer the warning) with an explicit
1118 gfc_warning_now_at (location_t loc
, int opt
, const char *gmsgid
, ...)
1121 diagnostic_info diagnostic
;
1122 rich_location
rich_loc (line_table
, loc
);
1125 va_start (argp
, gmsgid
);
1126 diagnostic_set_info (&diagnostic
, gmsgid
, &argp
, &rich_loc
, DK_WARNING
);
1127 diagnostic
.option_index
= opt
;
1128 ret
= report_diagnostic (&diagnostic
);
1133 /* Immediate warning (i.e. do not buffer the warning). */
1136 gfc_warning_now (int opt
, const char *gmsgid
, ...)
1139 diagnostic_info diagnostic
;
1140 rich_location
rich_loc (line_table
, UNKNOWN_LOCATION
);
1143 va_start (argp
, gmsgid
);
1144 diagnostic_set_info (&diagnostic
, gmsgid
, &argp
, &rich_loc
,
1146 diagnostic
.option_index
= opt
;
1147 ret
= report_diagnostic (&diagnostic
);
1153 /* Immediate error (i.e. do not buffer). */
1156 gfc_error_now (const char *gmsgid
, ...)
1159 diagnostic_info diagnostic
;
1160 rich_location
rich_loc (line_table
, UNKNOWN_LOCATION
);
1162 error_buffer
.flag
= true;
1164 va_start (argp
, gmsgid
);
1165 diagnostic_set_info (&diagnostic
, gmsgid
, &argp
, &rich_loc
, DK_ERROR
);
1166 report_diagnostic (&diagnostic
);
1171 /* Fatal error, never returns. */
1174 gfc_fatal_error (const char *gmsgid
, ...)
1177 diagnostic_info diagnostic
;
1178 rich_location
rich_loc (line_table
, UNKNOWN_LOCATION
);
1180 va_start (argp
, gmsgid
);
1181 diagnostic_set_info (&diagnostic
, gmsgid
, &argp
, &rich_loc
, DK_FATAL
);
1182 report_diagnostic (&diagnostic
);
1188 /* Clear the warning flag. */
1191 gfc_clear_warning (void)
1193 gfc_clear_pp_buffer (pp_warning_buffer
);
1194 warningcount_buffered
= 0;
1195 werrorcount_buffered
= 0;
1199 /* Check to see if any warnings have been saved.
1200 If so, print the warning. */
1203 gfc_warning_check (void)
1205 if (! gfc_output_buffer_empty_p (pp_warning_buffer
))
1207 pretty_printer
*pp
= global_dc
->printer
;
1208 output_buffer
*tmp_buffer
= pp
->buffer
;
1209 pp
->buffer
= pp_warning_buffer
;
1210 pp_really_flush (pp
);
1211 warningcount
+= warningcount_buffered
;
1212 werrorcount
+= werrorcount_buffered
;
1213 gcc_assert (warningcount_buffered
+ werrorcount_buffered
== 1);
1214 pp
->buffer
= tmp_buffer
;
1215 diagnostic_action_after_output (global_dc
,
1216 warningcount_buffered
1217 ? DK_WARNING
: DK_ERROR
);
1222 /* Issue an error. */
1225 gfc_error (const char *gmsgid
, va_list ap
)
1230 if (warnings_not_errors
)
1232 gfc_warning (/*opt=*/0, gmsgid
, argp
);
1237 if (suppress_errors
)
1243 diagnostic_info diagnostic
;
1244 rich_location
richloc (line_table
, UNKNOWN_LOCATION
);
1245 bool fatal_errors
= global_dc
->fatal_errors
;
1246 pretty_printer
*pp
= global_dc
->printer
;
1247 output_buffer
*tmp_buffer
= pp
->buffer
;
1249 gfc_clear_pp_buffer (pp_error_buffer
);
1253 pp
->buffer
= pp_error_buffer
;
1254 global_dc
->fatal_errors
= false;
1255 /* To prevent -fmax-errors= triggering, we decrease it before
1256 report_diagnostic increases it. */
1260 diagnostic_set_info (&diagnostic
, gmsgid
, &argp
, &richloc
, DK_ERROR
);
1261 report_diagnostic (&diagnostic
);
1265 pp
->buffer
= tmp_buffer
;
1266 global_dc
->fatal_errors
= fatal_errors
;
1274 gfc_error (const char *gmsgid
, ...)
1277 va_start (argp
, gmsgid
);
1278 gfc_error (gmsgid
, argp
);
1283 /* This shouldn't happen... but sometimes does. */
1286 gfc_internal_error (const char *gmsgid
, ...)
1289 diagnostic_info diagnostic
;
1290 rich_location
rich_loc (line_table
, UNKNOWN_LOCATION
);
1292 va_start (argp
, gmsgid
);
1293 diagnostic_set_info (&diagnostic
, gmsgid
, &argp
, &rich_loc
, DK_ICE
);
1294 report_diagnostic (&diagnostic
);
1301 /* Clear the error flag when we start to compile a source line. */
1304 gfc_clear_error (void)
1306 error_buffer
.flag
= 0;
1307 warnings_not_errors
= false;
1308 gfc_clear_pp_buffer (pp_error_buffer
);
1312 /* Tests the state of error_flag. */
1315 gfc_error_flag_test (void)
1317 return error_buffer
.flag
1318 || !gfc_output_buffer_empty_p (pp_error_buffer
);
1322 /* Check to see if any errors have been saved.
1323 If so, print the error. Returns the state of error_flag. */
1326 gfc_error_check (void)
1328 if (error_buffer
.flag
1329 || ! gfc_output_buffer_empty_p (pp_error_buffer
))
1331 error_buffer
.flag
= false;
1332 pretty_printer
*pp
= global_dc
->printer
;
1333 output_buffer
*tmp_buffer
= pp
->buffer
;
1334 pp
->buffer
= pp_error_buffer
;
1335 pp_really_flush (pp
);
1337 gcc_assert (gfc_output_buffer_empty_p (pp_error_buffer
));
1338 pp
->buffer
= tmp_buffer
;
1339 diagnostic_action_after_output (global_dc
, DK_ERROR
);
1346 /* Move the text buffered from FROM to TO, then clear
1347 FROM. Independently if there was text in FROM, TO is also
1351 gfc_move_error_buffer_from_to (gfc_error_buffer
* buffer_from
,
1352 gfc_error_buffer
* buffer_to
)
1354 output_buffer
* from
= &(buffer_from
->buffer
);
1355 output_buffer
* to
= &(buffer_to
->buffer
);
1357 buffer_to
->flag
= buffer_from
->flag
;
1358 buffer_from
->flag
= false;
1360 gfc_clear_pp_buffer (to
);
1361 /* We make sure this is always buffered. */
1362 to
->flush_p
= false;
1364 if (! gfc_output_buffer_empty_p (from
))
1366 const char *str
= output_buffer_formatted_text (from
);
1367 output_buffer_append_r (to
, str
, strlen (str
));
1368 gfc_clear_pp_buffer (from
);
1372 /* Save the existing error state. */
1375 gfc_push_error (gfc_error_buffer
*err
)
1377 gfc_move_error_buffer_from_to (&error_buffer
, err
);
1381 /* Restore a previous pushed error state. */
1384 gfc_pop_error (gfc_error_buffer
*err
)
1386 gfc_move_error_buffer_from_to (err
, &error_buffer
);
1390 /* Free a pushed error state, but keep the current error state. */
1393 gfc_free_error (gfc_error_buffer
*err
)
1395 gfc_clear_pp_buffer (&(err
->buffer
));
1399 /* Report the number of warnings and errors that occurred to the caller. */
1402 gfc_get_errors (int *w
, int *e
)
1405 *w
= warningcount
+ werrorcount
;
1407 *e
= errorcount
+ sorrycount
+ werrorcount
;
1411 /* Switch errors into warnings. */
1414 gfc_errors_to_warnings (bool f
)
1416 warnings_not_errors
= f
;
1420 gfc_diagnostics_init (void)
1422 diagnostic_starter (global_dc
) = gfc_diagnostic_starter
;
1423 diagnostic_finalizer (global_dc
) = gfc_diagnostic_finalizer
;
1424 diagnostic_format_decoder (global_dc
) = gfc_format_decoder
;
1425 global_dc
->caret_chars
[0] = '1';
1426 global_dc
->caret_chars
[1] = '2';
1427 pp_warning_buffer
= new (XNEW (output_buffer
)) output_buffer ();
1428 pp_warning_buffer
->flush_p
= false;
1429 /* pp_error_buffer is statically allocated. This simplifies memory
1430 management when using gfc_push/pop_error. */
1431 pp_error_buffer
= &(error_buffer
.buffer
);
1432 pp_error_buffer
->flush_p
= false;
1436 gfc_diagnostics_finish (void)
1438 tree_diagnostics_defaults (global_dc
);
1439 /* We still want to use the gfc starter and finalizer, not the tree
1441 diagnostic_starter (global_dc
) = gfc_diagnostic_starter
;
1442 diagnostic_finalizer (global_dc
) = gfc_diagnostic_finalizer
;
1443 global_dc
->caret_chars
[0] = '^';
1444 global_dc
->caret_chars
[1] = '^';