2 Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
4 Free Software Foundation, Inc.
5 Contributed by Andy Vaught & Niels Kristian Bech Jensen
7 This file is part of GCC.
9 GCC is free software; you can redistribute it and/or modify it under
10 the terms of the GNU General Public License as published by the Free
11 Software Foundation; either version 3, or (at your option) any later
14 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
15 WARRANTY; without even the implied warranty of MERCHANTABILITY or
16 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
19 You should have received a copy of the GNU General Public License
20 along with GCC; see the file COPYING3. If not see
21 <http://www.gnu.org/licenses/>. */
23 /* Handle the inevitable errors. A major catch here is that things
24 flagged as errors in one match subroutine can conceivably be legal
25 elsewhere. This means that error messages are recorded and saved
26 for possible use later. If a line does not match a legal
27 construction, then the saved error message is reported. */
34 static int suppress_errors
= 0;
36 static int warnings_not_errors
= 0;
38 static int terminal_width
, buffer_flag
, errors
, warnings
;
40 static gfc_error_buf error_buffer
, warning_buffer
, *cur_error_buffer
;
43 /* Go one level deeper suppressing errors. */
46 gfc_push_suppress_errors (void)
48 gcc_assert (suppress_errors
>= 0);
53 /* Leave one level of error suppressing. */
56 gfc_pop_suppress_errors (void)
58 gcc_assert (suppress_errors
> 0);
63 /* Per-file error initialization. */
66 gfc_error_init_1 (void)
68 terminal_width
= gfc_terminal_width ();
75 /* Set the flag for buffering errors or not. */
78 gfc_buffer_error (int flag
)
84 /* Add a single character to the error buffer or output depending on
92 if (cur_error_buffer
->index
>= cur_error_buffer
->allocated
)
94 cur_error_buffer
->allocated
= cur_error_buffer
->allocated
95 ? cur_error_buffer
->allocated
* 2 : 1000;
96 cur_error_buffer
->message
= XRESIZEVEC (char, cur_error_buffer
->message
,
97 cur_error_buffer
->allocated
);
99 cur_error_buffer
->message
[cur_error_buffer
->index
++] = c
;
105 /* We build up complete lines before handing things
106 over to the library in order to speed up error printing. */
108 static size_t allocated
= 0, index
= 0;
110 if (index
+ 1 >= allocated
)
112 allocated
= allocated
? allocated
* 2 : 1000;
113 line
= XRESIZEVEC (char, line
, allocated
);
119 fputs (line
, stderr
);
127 /* Copy a string to wherever it needs to go. */
130 error_string (const char *p
)
137 /* Print a formatted integer to the error buffer or output. */
142 error_uinteger (unsigned long int i
)
144 char *p
, int_buf
[IBUF_LEN
];
146 p
= int_buf
+ IBUF_LEN
- 1;
158 error_string (p
+ 1);
162 error_integer (long int i
)
168 u
= (unsigned long int) -i
;
179 gfc_widechar_display_length (gfc_char_t c
)
181 if (gfc_wide_is_printable (c
))
182 /* Simple ASCII character */
184 else if (c
< ((gfc_char_t
) 1 << 8))
185 /* Displayed as \x?? */
187 else if (c
< ((gfc_char_t
) 1 << 16))
188 /* Displayed as \u???? */
191 /* Displayed as \U???????? */
196 /* Length of the ASCII representation of the wide string, escaping wide
197 characters as print_wide_char_into_buffer() does. */
200 gfc_wide_display_length (const gfc_char_t
*str
)
204 for (i
= 0, len
= 0; str
[i
]; i
++)
205 len
+= gfc_widechar_display_length (str
[i
]);
211 print_wide_char_into_buffer (gfc_char_t c
, char *buf
)
213 static const char xdigit
[16] = { '0', '1', '2', '3', '4', '5', '6',
214 '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F' };
216 if (gfc_wide_is_printable (c
))
219 buf
[0] = (unsigned char) 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];
378 i
-= print_wide_char_into_buffer (c
, buffer
);
379 error_string (buffer
);
384 /* Show the '1' and/or '2' corresponding to the column of the error
385 locus. Note that a value of -1 for c1 or c2 will simply cause
386 the relevant number not to be printed. */
391 p
= &(lb
->line
[offset
]);
392 for (i
= 0; i
<= cmax
; i
++)
395 spaces
= gfc_widechar_display_length (*p
++);
398 error_char ('1'), spaces
--;
400 error_char ('2'), spaces
--;
402 for (j
= 0; j
< spaces
; j
++)
411 /* As part of printing an error, we show the source lines that caused
412 the problem. We show at least one, and possibly two loci; the two
413 loci may or may not be on the same source line. */
416 show_loci (locus
*l1
, locus
*l2
)
420 if (l1
== NULL
|| l1
->lb
== NULL
)
422 error_printf ("<During initialization>\n");
426 /* While calculating parameters for printing the loci, we consider possible
427 reasons for printing one per line. If appropriate, print the loci
428 individually; otherwise we print them both on the same line. */
430 c1
= l1
->nextc
- l1
->lb
->line
;
433 show_locus (l1
, c1
, -1);
437 c2
= l2
->nextc
- l2
->lb
->line
;
444 /* Note that the margin value of 10 here needs to be less than the
445 margin of 5 used in the calculation of offset in show_locus. */
447 if (l1
->lb
!= l2
->lb
|| m
> terminal_width
- 10)
449 show_locus (l1
, c1
, -1);
450 show_locus (l2
, -1, c2
);
454 show_locus (l1
, c1
, c2
);
460 /* Workhorse for the error printing subroutines. This subroutine is
461 inspired by g77's error handling and is similar to printf() with
462 the following %-codes:
464 %c Character, %d or %i Integer, %s String, %% Percent
465 %L Takes locus argument
466 %C Current locus (no argument)
468 If a locus pointer is given, the actual source line is printed out
469 and the column is indicated. Since we want the error message at
470 the bottom of any source file information, we must scan the
471 argument list twice -- once to determine whether the loci are
472 present and record this for printing, and once to print the error
473 message after and loci have been printed. A maximum of two locus
474 arguments are permitted.
476 This function is also called (recursively) by show_locus in the
477 case of included files; however, as show_locus does not resupply
478 any loci, the recursion is at most one level deep. */
482 static void ATTRIBUTE_GCC_GFC(2,0)
483 error_print (const char *type
, const char *format0
, va_list argp
)
485 enum { TYPE_CURRENTLOC
, TYPE_LOCUS
, TYPE_INTEGER
, TYPE_UINTEGER
,
486 TYPE_LONGINT
, TYPE_ULONGINT
, TYPE_CHAR
, TYPE_STRING
,
495 unsigned int uintval
;
497 unsigned long int ulongintval
;
499 const char * stringval
;
501 } arg
[MAX_ARGS
], spec
[MAX_ARGS
];
502 /* spec is the array of specifiers, in the same order as they
503 appear in the format string. arg is the array of arguments,
504 in the same order as they appear in the va_list. */
507 int i
, n
, have_l1
, pos
, maxpos
;
508 locus
*l1
, *l2
, *loc
;
511 loc
= l1
= l2
= NULL
;
520 for (i
= 0; i
< MAX_ARGS
; i
++)
522 arg
[i
].type
= NOTYPE
;
526 /* First parse the format string for position specifiers. */
539 if (ISDIGIT (*format
))
541 /* This is a position specifier. For example, the number
542 12 in the format string "%12$d", which specifies the third
543 argument of the va_list, formatted in %d format.
544 For details, see "man 3 printf". */
545 pos
= atoi(format
) - 1;
546 gcc_assert (pos
>= 0);
547 while (ISDIGIT(*format
))
549 gcc_assert (*format
++ == '$');
562 arg
[pos
].type
= TYPE_CURRENTLOC
;
566 arg
[pos
].type
= TYPE_LOCUS
;
571 arg
[pos
].type
= TYPE_INTEGER
;
575 arg
[pos
].type
= TYPE_UINTEGER
;
581 arg
[pos
].type
= TYPE_ULONGINT
;
582 else if (c
== 'i' || c
== 'd')
583 arg
[pos
].type
= TYPE_LONGINT
;
589 arg
[pos
].type
= TYPE_CHAR
;
593 arg
[pos
].type
= TYPE_STRING
;
603 /* Then convert the values for each %-style argument. */
604 for (pos
= 0; pos
<= maxpos
; pos
++)
606 gcc_assert (arg
[pos
].type
!= NOTYPE
);
607 switch (arg
[pos
].type
)
609 case TYPE_CURRENTLOC
:
610 loc
= &gfc_current_locus
;
614 if (arg
[pos
].type
== TYPE_LOCUS
)
615 loc
= va_arg (argp
, locus
*);
620 arg
[pos
].u
.stringval
= "(2)";
626 arg
[pos
].u
.stringval
= "(1)";
631 arg
[pos
].u
.intval
= va_arg (argp
, int);
635 arg
[pos
].u
.uintval
= va_arg (argp
, unsigned int);
639 arg
[pos
].u
.longintval
= va_arg (argp
, long int);
643 arg
[pos
].u
.ulongintval
= va_arg (argp
, unsigned long int);
647 arg
[pos
].u
.charval
= (char) va_arg (argp
, int);
651 arg
[pos
].u
.stringval
= (const char *) va_arg (argp
, char *);
659 for (n
= 0; spec
[n
].pos
>= 0; n
++)
660 spec
[n
].u
= arg
[spec
[n
].pos
].u
;
662 /* Show the current loci if we have to. */
676 for (; *format
; format
++)
680 error_char (*format
);
685 if (ISDIGIT (*format
))
687 /* This is a position specifier. See comment above. */
688 while (ISDIGIT (*format
))
691 /* Skip over the dollar sign. */
702 error_char (spec
[n
++].u
.charval
);
706 case 'C': /* Current locus */
707 case 'L': /* Specified locus */
708 error_string (spec
[n
++].u
.stringval
);
713 error_integer (spec
[n
++].u
.intval
);
717 error_uinteger (spec
[n
++].u
.uintval
);
723 error_uinteger (spec
[n
++].u
.ulongintval
);
725 error_integer (spec
[n
++].u
.longintval
);
735 /* Wrapper for error_print(). */
738 error_printf (const char *gmsgid
, ...)
742 va_start (argp
, gmsgid
);
743 error_print ("", _(gmsgid
), argp
);
748 /* Increment the number of errors, and check whether too many have
752 gfc_increment_error_count (void)
755 if ((gfc_option
.max_errors
!= 0) && (errors
>= gfc_option
.max_errors
))
756 gfc_fatal_error ("Error count reached limit of %d.", gfc_option
.max_errors
);
760 /* Issue a warning. */
763 gfc_warning (const char *gmsgid
, ...)
767 if (inhibit_warnings
)
770 warning_buffer
.flag
= 1;
771 warning_buffer
.index
= 0;
772 cur_error_buffer
= &warning_buffer
;
774 va_start (argp
, gmsgid
);
775 error_print (_("Warning:"), _(gmsgid
), argp
);
780 if (buffer_flag
== 0)
783 if (warnings_are_errors
)
784 gfc_increment_error_count();
789 /* Whether, for a feature included in a given standard set (GFC_STD_*),
790 we should issue an error or a warning, or be quiet. */
793 gfc_notification_std (int std
)
797 warning
= ((gfc_option
.warn_std
& std
) != 0) && !inhibit_warnings
;
798 if ((gfc_option
.allow_std
& std
) != 0 && !warning
)
801 return warning
? WARNING
: ERROR
;
805 /* Possibly issue a warning/error about use of a nonstandard (or deleted)
806 feature. An error/warning will be issued if the currently selected
807 standard does not contain the requested bits. Return FAILURE if
808 an error is generated. */
811 gfc_notify_std (int std
, const char *gmsgid
, ...)
816 warning
= ((gfc_option
.warn_std
& std
) != 0) && !inhibit_warnings
;
817 if ((gfc_option
.allow_std
& std
) != 0 && !warning
)
821 return warning
? SUCCESS
: FAILURE
;
823 cur_error_buffer
= warning
? &warning_buffer
: &error_buffer
;
824 cur_error_buffer
->flag
= 1;
825 cur_error_buffer
->index
= 0;
827 va_start (argp
, gmsgid
);
829 error_print (_("Warning:"), _(gmsgid
), argp
);
831 error_print (_("Error:"), _(gmsgid
), argp
);
836 if (buffer_flag
== 0)
838 if (warning
&& !warnings_are_errors
)
841 gfc_increment_error_count();
844 return (warning
&& !warnings_are_errors
) ? SUCCESS
: FAILURE
;
848 /* Immediate warning (i.e. do not buffer the warning). */
851 gfc_warning_now (const char *gmsgid
, ...)
856 if (inhibit_warnings
)
863 va_start (argp
, gmsgid
);
864 error_print (_("Warning:"), _(gmsgid
), argp
);
869 if (warnings_are_errors
)
870 gfc_increment_error_count();
876 /* Clear the warning flag. */
879 gfc_clear_warning (void)
881 warning_buffer
.flag
= 0;
885 /* Check to see if any warnings have been saved.
886 If so, print the warning. */
889 gfc_warning_check (void)
891 if (warning_buffer
.flag
)
894 if (warning_buffer
.message
!= NULL
)
895 fputs (warning_buffer
.message
, stderr
);
896 warning_buffer
.flag
= 0;
901 /* Issue an error. */
904 gfc_error (const char *gmsgid
, ...)
908 if (warnings_not_errors
)
914 error_buffer
.flag
= 1;
915 error_buffer
.index
= 0;
916 cur_error_buffer
= &error_buffer
;
918 va_start (argp
, gmsgid
);
919 error_print (_("Error:"), _(gmsgid
), argp
);
924 if (buffer_flag
== 0)
925 gfc_increment_error_count();
931 if (inhibit_warnings
)
934 warning_buffer
.flag
= 1;
935 warning_buffer
.index
= 0;
936 cur_error_buffer
= &warning_buffer
;
938 va_start (argp
, gmsgid
);
939 error_print (_("Warning:"), _(gmsgid
), argp
);
944 if (buffer_flag
== 0)
947 if (warnings_are_errors
)
948 gfc_increment_error_count();
953 /* Immediate error. */
956 gfc_error_now (const char *gmsgid
, ...)
961 error_buffer
.flag
= 1;
962 error_buffer
.index
= 0;
963 cur_error_buffer
= &error_buffer
;
968 va_start (argp
, gmsgid
);
969 error_print (_("Error:"), _(gmsgid
), argp
);
974 gfc_increment_error_count();
978 if (flag_fatal_errors
)
979 exit (FATAL_EXIT_CODE
);
983 /* Fatal error, never returns. */
986 gfc_fatal_error (const char *gmsgid
, ...)
992 va_start (argp
, gmsgid
);
993 error_print (_("Fatal Error:"), _(gmsgid
), argp
);
996 exit (FATAL_EXIT_CODE
);
1000 /* This shouldn't happen... but sometimes does. */
1003 gfc_internal_error (const char *format
, ...)
1009 va_start (argp
, format
);
1011 show_loci (&gfc_current_locus
, NULL
);
1012 error_printf ("Internal Error at (1):");
1014 error_print ("", format
, argp
);
1017 exit (ICE_EXIT_CODE
);
1021 /* Clear the error flag when we start to compile a source line. */
1024 gfc_clear_error (void)
1026 error_buffer
.flag
= 0;
1027 warnings_not_errors
= 0;
1031 /* Tests the state of error_flag. */
1034 gfc_error_flag_test (void)
1036 return error_buffer
.flag
;
1040 /* Check to see if any errors have been saved.
1041 If so, print the error. Returns the state of error_flag. */
1044 gfc_error_check (void)
1048 rc
= error_buffer
.flag
;
1050 if (error_buffer
.flag
)
1052 if (error_buffer
.message
!= NULL
)
1053 fputs (error_buffer
.message
, stderr
);
1054 error_buffer
.flag
= 0;
1056 gfc_increment_error_count();
1058 if (flag_fatal_errors
)
1059 exit (FATAL_EXIT_CODE
);
1066 /* Save the existing error state. */
1069 gfc_push_error (gfc_error_buf
*err
)
1071 err
->flag
= error_buffer
.flag
;
1072 if (error_buffer
.flag
)
1073 err
->message
= xstrdup (error_buffer
.message
);
1075 error_buffer
.flag
= 0;
1079 /* Restore a previous pushed error state. */
1082 gfc_pop_error (gfc_error_buf
*err
)
1084 error_buffer
.flag
= err
->flag
;
1085 if (error_buffer
.flag
)
1087 size_t len
= strlen (err
->message
) + 1;
1088 gcc_assert (len
<= error_buffer
.allocated
);
1089 memcpy (error_buffer
.message
, err
->message
, len
);
1090 free (err
->message
);
1095 /* Free a pushed error state, but keep the current error state. */
1098 gfc_free_error (gfc_error_buf
*err
)
1101 free (err
->message
);
1105 /* Report the number of warnings and errors that occurred to the caller. */
1108 gfc_get_errors (int *w
, int *e
)
1117 /* Switch errors into warnings. */
1120 gfc_errors_to_warnings (int f
)
1122 warnings_not_errors
= (f
== 1) ? 1 : 0;