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 print_wide_char_into_buffer (gfc_char_t c
, char *buf
)
181 static const char xdigit
[16] = { '0', '1', '2', '3', '4', '5', '6',
182 '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F' };
184 if (gfc_wide_is_printable (c
))
187 buf
[0] = (unsigned char) c
;
189 else if (c
< ((gfc_char_t
) 1 << 8))
192 buf
[3] = xdigit
[c
& 0x0F];
194 buf
[2] = xdigit
[c
& 0x0F];
199 else if (c
< ((gfc_char_t
) 1 << 16))
202 buf
[5] = xdigit
[c
& 0x0F];
204 buf
[4] = xdigit
[c
& 0x0F];
206 buf
[3] = xdigit
[c
& 0x0F];
208 buf
[2] = xdigit
[c
& 0x0F];
216 buf
[9] = xdigit
[c
& 0x0F];
218 buf
[8] = xdigit
[c
& 0x0F];
220 buf
[7] = xdigit
[c
& 0x0F];
222 buf
[6] = xdigit
[c
& 0x0F];
224 buf
[5] = xdigit
[c
& 0x0F];
226 buf
[4] = xdigit
[c
& 0x0F];
228 buf
[3] = xdigit
[c
& 0x0F];
230 buf
[2] = xdigit
[c
& 0x0F];
237 static char wide_char_print_buffer
[11];
240 gfc_print_wide_char (gfc_char_t c
)
242 print_wide_char_into_buffer (c
, wide_char_print_buffer
);
243 return wide_char_print_buffer
;
247 /* Show the file, where it was included, and the source line, give a
248 locus. Calls error_printf() recursively, but the recursion is at
249 most one level deep. */
251 static void error_printf (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
254 show_locus (locus
*loc
, int c1
, int c2
)
261 /* TODO: Either limit the total length and number of included files
262 displayed or add buffering of arbitrary number of characters in
265 /* Write out the error header line, giving the source file and error
266 location (in GNU standard "[file]:[line].[column]:" format),
267 followed by an "included by" stack and a blank line. This header
268 format is matched by a testsuite parser defined in
269 lib/gfortran-dg.exp. */
274 error_string (f
->filename
);
277 error_integer (LOCATION_LINE (lb
->location
));
279 if ((c1
> 0) || (c2
> 0))
285 if ((c1
> 0) && (c2
> 0))
296 i
= f
->inclusion_line
;
299 if (f
== NULL
) break;
301 error_printf (" Included at %s:%d:", f
->filename
, i
);
306 /* Calculate an appropriate horizontal offset of the source line in
307 order to get the error locus within the visible portion of the
308 line. Note that if the margin of 5 here is changed, the
309 corresponding margin of 10 in show_loci should be changed. */
313 /* If the two loci would appear in the same column, we shift
314 '2' one column to the right, so as to print '12' rather than
315 just '1'. We do this here so it will be accounted for in the
316 margin calculations. */
321 cmax
= (c1
< c2
) ? c2
: c1
;
322 if (cmax
> terminal_width
- 5)
323 offset
= cmax
- terminal_width
+ 5;
325 /* Show the line itself, taking care not to print more than what can
326 show up on the terminal. Tabs are converted to spaces, and
327 nonprintable characters are converted to a "\xNN" sequence. */
329 /* TODO: Although setting i to the terminal width is clever, it fails
330 to work correctly when nonprintable characters exist. A better
331 solution should be found. */
333 p
= &(lb
->line
[offset
]);
334 i
= gfc_wide_strlen (p
);
335 if (i
> terminal_width
)
336 i
= terminal_width
- 1;
340 static char buffer
[11];
346 print_wide_char_into_buffer (c
, buffer
);
347 error_string (buffer
);
352 /* Show the '1' and/or '2' corresponding to the column of the error
353 locus. Note that a value of -1 for c1 or c2 will simply cause
354 the relevant number not to be printed. */
359 for (i
= 0; i
<= cmax
; i
++)
374 /* As part of printing an error, we show the source lines that caused
375 the problem. We show at least one, and possibly two loci; the two
376 loci may or may not be on the same source line. */
379 show_loci (locus
*l1
, locus
*l2
)
383 if (l1
== NULL
|| l1
->lb
== NULL
)
385 error_printf ("<During initialization>\n");
389 /* While calculating parameters for printing the loci, we consider possible
390 reasons for printing one per line. If appropriate, print the loci
391 individually; otherwise we print them both on the same line. */
393 c1
= l1
->nextc
- l1
->lb
->line
;
396 show_locus (l1
, c1
, -1);
400 c2
= l2
->nextc
- l2
->lb
->line
;
407 /* Note that the margin value of 10 here needs to be less than the
408 margin of 5 used in the calculation of offset in show_locus. */
410 if (l1
->lb
!= l2
->lb
|| m
> terminal_width
- 10)
412 show_locus (l1
, c1
, -1);
413 show_locus (l2
, -1, c2
);
417 show_locus (l1
, c1
, c2
);
423 /* Workhorse for the error printing subroutines. This subroutine is
424 inspired by g77's error handling and is similar to printf() with
425 the following %-codes:
427 %c Character, %d or %i Integer, %s String, %% Percent
428 %L Takes locus argument
429 %C Current locus (no argument)
431 If a locus pointer is given, the actual source line is printed out
432 and the column is indicated. Since we want the error message at
433 the bottom of any source file information, we must scan the
434 argument list twice -- once to determine whether the loci are
435 present and record this for printing, and once to print the error
436 message after and loci have been printed. A maximum of two locus
437 arguments are permitted.
439 This function is also called (recursively) by show_locus in the
440 case of included files; however, as show_locus does not resupply
441 any loci, the recursion is at most one level deep. */
445 static void ATTRIBUTE_GCC_GFC(2,0)
446 error_print (const char *type
, const char *format0
, va_list argp
)
448 enum { TYPE_CURRENTLOC
, TYPE_LOCUS
, TYPE_INTEGER
, TYPE_UINTEGER
,
449 TYPE_LONGINT
, TYPE_ULONGINT
, TYPE_CHAR
, TYPE_STRING
,
458 unsigned int uintval
;
460 unsigned long int ulongintval
;
462 const char * stringval
;
464 } arg
[MAX_ARGS
], spec
[MAX_ARGS
];
465 /* spec is the array of specifiers, in the same order as they
466 appear in the format string. arg is the array of arguments,
467 in the same order as they appear in the va_list. */
470 int i
, n
, have_l1
, pos
, maxpos
;
471 locus
*l1
, *l2
, *loc
;
474 loc
= l1
= l2
= NULL
;
483 for (i
= 0; i
< MAX_ARGS
; i
++)
485 arg
[i
].type
= NOTYPE
;
489 /* First parse the format string for position specifiers. */
502 if (ISDIGIT (*format
))
504 /* This is a position specifier. For example, the number
505 12 in the format string "%12$d", which specifies the third
506 argument of the va_list, formatted in %d format.
507 For details, see "man 3 printf". */
508 pos
= atoi(format
) - 1;
509 gcc_assert (pos
>= 0);
510 while (ISDIGIT(*format
))
512 gcc_assert (*format
++ == '$');
525 arg
[pos
].type
= TYPE_CURRENTLOC
;
529 arg
[pos
].type
= TYPE_LOCUS
;
534 arg
[pos
].type
= TYPE_INTEGER
;
538 arg
[pos
].type
= TYPE_UINTEGER
;
544 arg
[pos
].type
= TYPE_ULONGINT
;
545 else if (c
== 'i' || c
== 'd')
546 arg
[pos
].type
= TYPE_LONGINT
;
552 arg
[pos
].type
= TYPE_CHAR
;
556 arg
[pos
].type
= TYPE_STRING
;
566 /* Then convert the values for each %-style argument. */
567 for (pos
= 0; pos
<= maxpos
; pos
++)
569 gcc_assert (arg
[pos
].type
!= NOTYPE
);
570 switch (arg
[pos
].type
)
572 case TYPE_CURRENTLOC
:
573 loc
= &gfc_current_locus
;
577 if (arg
[pos
].type
== TYPE_LOCUS
)
578 loc
= va_arg (argp
, locus
*);
583 arg
[pos
].u
.stringval
= "(2)";
589 arg
[pos
].u
.stringval
= "(1)";
594 arg
[pos
].u
.intval
= va_arg (argp
, int);
598 arg
[pos
].u
.uintval
= va_arg (argp
, unsigned int);
602 arg
[pos
].u
.longintval
= va_arg (argp
, long int);
606 arg
[pos
].u
.ulongintval
= va_arg (argp
, unsigned long int);
610 arg
[pos
].u
.charval
= (char) va_arg (argp
, int);
614 arg
[pos
].u
.stringval
= (const char *) va_arg (argp
, char *);
622 for (n
= 0; spec
[n
].pos
>= 0; n
++)
623 spec
[n
].u
= arg
[spec
[n
].pos
].u
;
625 /* Show the current loci if we have to. */
639 for (; *format
; format
++)
643 error_char (*format
);
648 if (ISDIGIT (*format
))
650 /* This is a position specifier. See comment above. */
651 while (ISDIGIT (*format
))
654 /* Skip over the dollar sign. */
665 error_char (spec
[n
++].u
.charval
);
669 case 'C': /* Current locus */
670 case 'L': /* Specified locus */
671 error_string (spec
[n
++].u
.stringval
);
676 error_integer (spec
[n
++].u
.intval
);
680 error_uinteger (spec
[n
++].u
.uintval
);
686 error_uinteger (spec
[n
++].u
.ulongintval
);
688 error_integer (spec
[n
++].u
.longintval
);
698 /* Wrapper for error_print(). */
701 error_printf (const char *gmsgid
, ...)
705 va_start (argp
, gmsgid
);
706 error_print ("", _(gmsgid
), argp
);
711 /* Increment the number of errors, and check whether too many have
715 gfc_increment_error_count (void)
718 if ((gfc_option
.max_errors
!= 0) && (errors
>= gfc_option
.max_errors
))
719 gfc_fatal_error ("Error count reached limit of %d.", gfc_option
.max_errors
);
723 /* Issue a warning. */
726 gfc_warning (const char *gmsgid
, ...)
730 if (inhibit_warnings
)
733 warning_buffer
.flag
= 1;
734 warning_buffer
.index
= 0;
735 cur_error_buffer
= &warning_buffer
;
737 va_start (argp
, gmsgid
);
738 error_print (_("Warning:"), _(gmsgid
), argp
);
743 if (buffer_flag
== 0)
746 if (warnings_are_errors
)
747 gfc_increment_error_count();
752 /* Whether, for a feature included in a given standard set (GFC_STD_*),
753 we should issue an error or a warning, or be quiet. */
756 gfc_notification_std (int std
)
760 warning
= ((gfc_option
.warn_std
& std
) != 0) && !inhibit_warnings
;
761 if ((gfc_option
.allow_std
& std
) != 0 && !warning
)
764 return warning
? WARNING
: ERROR
;
768 /* Possibly issue a warning/error about use of a nonstandard (or deleted)
769 feature. An error/warning will be issued if the currently selected
770 standard does not contain the requested bits. Return FAILURE if
771 an error is generated. */
774 gfc_notify_std (int std
, const char *gmsgid
, ...)
779 warning
= ((gfc_option
.warn_std
& std
) != 0) && !inhibit_warnings
;
780 if ((gfc_option
.allow_std
& std
) != 0 && !warning
)
784 return warning
? SUCCESS
: FAILURE
;
786 cur_error_buffer
= warning
? &warning_buffer
: &error_buffer
;
787 cur_error_buffer
->flag
= 1;
788 cur_error_buffer
->index
= 0;
790 va_start (argp
, gmsgid
);
792 error_print (_("Warning:"), _(gmsgid
), argp
);
794 error_print (_("Error:"), _(gmsgid
), argp
);
799 if (buffer_flag
== 0)
801 if (warning
&& !warnings_are_errors
)
804 gfc_increment_error_count();
807 return (warning
&& !warnings_are_errors
) ? SUCCESS
: FAILURE
;
811 /* Immediate warning (i.e. do not buffer the warning). */
814 gfc_warning_now (const char *gmsgid
, ...)
819 if (inhibit_warnings
)
826 va_start (argp
, gmsgid
);
827 error_print (_("Warning:"), _(gmsgid
), argp
);
832 if (warnings_are_errors
)
833 gfc_increment_error_count();
839 /* Clear the warning flag. */
842 gfc_clear_warning (void)
844 warning_buffer
.flag
= 0;
848 /* Check to see if any warnings have been saved.
849 If so, print the warning. */
852 gfc_warning_check (void)
854 if (warning_buffer
.flag
)
857 if (warning_buffer
.message
!= NULL
)
858 fputs (warning_buffer
.message
, stderr
);
859 warning_buffer
.flag
= 0;
864 /* Issue an error. */
867 gfc_error (const char *gmsgid
, ...)
871 if (warnings_not_errors
)
877 error_buffer
.flag
= 1;
878 error_buffer
.index
= 0;
879 cur_error_buffer
= &error_buffer
;
881 va_start (argp
, gmsgid
);
882 error_print (_("Error:"), _(gmsgid
), argp
);
887 if (buffer_flag
== 0)
888 gfc_increment_error_count();
894 if (inhibit_warnings
)
897 warning_buffer
.flag
= 1;
898 warning_buffer
.index
= 0;
899 cur_error_buffer
= &warning_buffer
;
901 va_start (argp
, gmsgid
);
902 error_print (_("Warning:"), _(gmsgid
), argp
);
907 if (buffer_flag
== 0)
910 if (warnings_are_errors
)
911 gfc_increment_error_count();
916 /* Immediate error. */
919 gfc_error_now (const char *gmsgid
, ...)
924 error_buffer
.flag
= 1;
925 error_buffer
.index
= 0;
926 cur_error_buffer
= &error_buffer
;
931 va_start (argp
, gmsgid
);
932 error_print (_("Error:"), _(gmsgid
), argp
);
937 gfc_increment_error_count();
941 if (flag_fatal_errors
)
946 /* Fatal error, never returns. */
949 gfc_fatal_error (const char *gmsgid
, ...)
955 va_start (argp
, gmsgid
);
956 error_print (_("Fatal Error:"), _(gmsgid
), argp
);
963 /* This shouldn't happen... but sometimes does. */
966 gfc_internal_error (const char *format
, ...)
972 va_start (argp
, format
);
974 show_loci (&gfc_current_locus
, NULL
);
975 error_printf ("Internal Error at (1):");
977 error_print ("", format
, argp
);
980 exit (ICE_EXIT_CODE
);
984 /* Clear the error flag when we start to compile a source line. */
987 gfc_clear_error (void)
989 error_buffer
.flag
= 0;
990 warnings_not_errors
= 0;
994 /* Tests the state of error_flag. */
997 gfc_error_flag_test (void)
999 return error_buffer
.flag
;
1003 /* Check to see if any errors have been saved.
1004 If so, print the error. Returns the state of error_flag. */
1007 gfc_error_check (void)
1011 rc
= error_buffer
.flag
;
1013 if (error_buffer
.flag
)
1015 if (error_buffer
.message
!= NULL
)
1016 fputs (error_buffer
.message
, stderr
);
1017 error_buffer
.flag
= 0;
1019 gfc_increment_error_count();
1021 if (flag_fatal_errors
)
1029 /* Save the existing error state. */
1032 gfc_push_error (gfc_error_buf
*err
)
1034 err
->flag
= error_buffer
.flag
;
1035 if (error_buffer
.flag
)
1036 err
->message
= xstrdup (error_buffer
.message
);
1038 error_buffer
.flag
= 0;
1042 /* Restore a previous pushed error state. */
1045 gfc_pop_error (gfc_error_buf
*err
)
1047 error_buffer
.flag
= err
->flag
;
1048 if (error_buffer
.flag
)
1050 size_t len
= strlen (err
->message
) + 1;
1051 gcc_assert (len
<= error_buffer
.allocated
);
1052 memcpy (error_buffer
.message
, err
->message
, len
);
1053 gfc_free (err
->message
);
1058 /* Free a pushed error state, but keep the current error state. */
1061 gfc_free_error (gfc_error_buf
*err
)
1064 gfc_free (err
->message
);
1068 /* Report the number of warnings and errors that occurred to the caller. */
1071 gfc_get_errors (int *w
, int *e
)
1080 /* Switch errors into warnings. */
1083 gfc_errors_to_warnings (int f
)
1085 warnings_not_errors
= (f
== 1) ? 1 : 0;