2 Copyright (C) 2000-2013 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 static int suppress_errors
= 0;
35 static int warnings_not_errors
= 0;
37 static int terminal_width
, buffer_flag
, errors
, warnings
;
39 static gfc_error_buf error_buffer
, warning_buffer
, *cur_error_buffer
;
42 /* Go one level deeper suppressing errors. */
45 gfc_push_suppress_errors (void)
47 gcc_assert (suppress_errors
>= 0);
52 /* Leave one level of error suppressing. */
55 gfc_pop_suppress_errors (void)
57 gcc_assert (suppress_errors
> 0);
62 /* Per-file error initialization. */
65 gfc_error_init_1 (void)
67 terminal_width
= gfc_terminal_width ();
74 /* Set the flag for buffering errors or not. */
77 gfc_buffer_error (int flag
)
83 /* Add a single character to the error buffer or output depending on
91 if (cur_error_buffer
->index
>= cur_error_buffer
->allocated
)
93 cur_error_buffer
->allocated
= cur_error_buffer
->allocated
94 ? cur_error_buffer
->allocated
* 2 : 1000;
95 cur_error_buffer
->message
= XRESIZEVEC (char, cur_error_buffer
->message
,
96 cur_error_buffer
->allocated
);
98 cur_error_buffer
->message
[cur_error_buffer
->index
++] = c
;
104 /* We build up complete lines before handing things
105 over to the library in order to speed up error printing. */
107 static size_t allocated
= 0, index
= 0;
109 if (index
+ 1 >= allocated
)
111 allocated
= allocated
? allocated
* 2 : 1000;
112 line
= XRESIZEVEC (char, line
, allocated
);
118 fputs (line
, stderr
);
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 /* Increment the number of errors, and check whether too many have
754 gfc_increment_error_count (void)
757 if ((gfc_option
.max_errors
!= 0) && (errors
>= gfc_option
.max_errors
))
758 gfc_fatal_error ("Error count reached limit of %d.", gfc_option
.max_errors
);
762 /* Issue a warning. */
765 gfc_warning (const char *gmsgid
, ...)
769 if (inhibit_warnings
)
772 warning_buffer
.flag
= 1;
773 warning_buffer
.index
= 0;
774 cur_error_buffer
= &warning_buffer
;
776 va_start (argp
, gmsgid
);
777 error_print (_("Warning:"), _(gmsgid
), argp
);
782 if (buffer_flag
== 0)
785 if (warnings_are_errors
)
786 gfc_increment_error_count();
791 /* Whether, for a feature included in a given standard set (GFC_STD_*),
792 we should issue an error or a warning, or be quiet. */
795 gfc_notification_std (int std
)
799 warning
= ((gfc_option
.warn_std
& std
) != 0) && !inhibit_warnings
;
800 if ((gfc_option
.allow_std
& std
) != 0 && !warning
)
803 return warning
? WARNING
: ERROR
;
807 /* Possibly issue a warning/error about use of a nonstandard (or deleted)
808 feature. An error/warning will be issued if the currently selected
809 standard does not contain the requested bits. Return false if
810 an error is generated. */
813 gfc_notify_std (int std
, const char *gmsgid
, ...)
817 const char *msg1
, *msg2
;
820 warning
= ((gfc_option
.warn_std
& std
) != 0) && !inhibit_warnings
;
821 if ((gfc_option
.allow_std
& std
) != 0 && !warning
)
825 return warning
? true : false;
827 cur_error_buffer
= warning
? &warning_buffer
: &error_buffer
;
828 cur_error_buffer
->flag
= 1;
829 cur_error_buffer
->index
= 0;
832 msg1
= _("Warning:");
838 case GFC_STD_F2008_TS
:
841 case GFC_STD_F2008_OBS
:
842 msg2
= _("Fortran 2008 obsolescent feature:");
845 msg2
= "Fortran 2008:";
848 msg2
= "Fortran 2003:";
851 msg2
= _("GNU Extension:");
854 msg2
= _("Legacy Extension:");
856 case GFC_STD_F95_OBS
:
857 msg2
= _("Obsolescent feature:");
859 case GFC_STD_F95_DEL
:
860 msg2
= _("Deleted feature:");
866 buffer
= (char *) alloca (strlen (msg1
) + strlen (msg2
) + 2);
867 strcpy (buffer
, msg1
);
868 strcat (buffer
, " ");
869 strcat (buffer
, msg2
);
871 va_start (argp
, gmsgid
);
872 error_print (buffer
, _(gmsgid
), argp
);
877 if (buffer_flag
== 0)
879 if (warning
&& !warnings_are_errors
)
882 gfc_increment_error_count();
883 cur_error_buffer
->flag
= 0;
886 return (warning
&& !warnings_are_errors
) ? true : false;
890 /* Immediate warning (i.e. do not buffer the warning). */
893 gfc_warning_now (const char *gmsgid
, ...)
898 if (inhibit_warnings
)
905 va_start (argp
, gmsgid
);
906 error_print (_("Warning:"), _(gmsgid
), argp
);
911 if (warnings_are_errors
)
912 gfc_increment_error_count();
918 /* Clear the warning flag. */
921 gfc_clear_warning (void)
923 warning_buffer
.flag
= 0;
927 /* Check to see if any warnings have been saved.
928 If so, print the warning. */
931 gfc_warning_check (void)
933 if (warning_buffer
.flag
)
936 if (warning_buffer
.message
!= NULL
)
937 fputs (warning_buffer
.message
, stderr
);
938 warning_buffer
.flag
= 0;
943 /* Issue an error. */
946 gfc_error (const char *gmsgid
, ...)
950 if (warnings_not_errors
)
956 error_buffer
.flag
= 1;
957 error_buffer
.index
= 0;
958 cur_error_buffer
= &error_buffer
;
960 va_start (argp
, gmsgid
);
961 error_print (_("Error:"), _(gmsgid
), argp
);
966 if (buffer_flag
== 0)
967 gfc_increment_error_count();
973 if (inhibit_warnings
)
976 warning_buffer
.flag
= 1;
977 warning_buffer
.index
= 0;
978 cur_error_buffer
= &warning_buffer
;
980 va_start (argp
, gmsgid
);
981 error_print (_("Warning:"), _(gmsgid
), argp
);
986 if (buffer_flag
== 0)
989 if (warnings_are_errors
)
990 gfc_increment_error_count();
995 /* Immediate error. */
998 gfc_error_now (const char *gmsgid
, ...)
1003 error_buffer
.flag
= 1;
1004 error_buffer
.index
= 0;
1005 cur_error_buffer
= &error_buffer
;
1010 va_start (argp
, gmsgid
);
1011 error_print (_("Error:"), _(gmsgid
), argp
);
1016 gfc_increment_error_count();
1020 if (flag_fatal_errors
)
1021 exit (FATAL_EXIT_CODE
);
1025 /* Fatal error, never returns. */
1028 gfc_fatal_error (const char *gmsgid
, ...)
1034 va_start (argp
, gmsgid
);
1035 error_print (_("Fatal Error:"), _(gmsgid
), argp
);
1038 exit (FATAL_EXIT_CODE
);
1042 /* This shouldn't happen... but sometimes does. */
1045 gfc_internal_error (const char *format
, ...)
1051 va_start (argp
, format
);
1053 show_loci (&gfc_current_locus
, NULL
);
1054 error_printf ("Internal Error at (1):");
1056 error_print ("", format
, argp
);
1059 exit (ICE_EXIT_CODE
);
1063 /* Clear the error flag when we start to compile a source line. */
1066 gfc_clear_error (void)
1068 error_buffer
.flag
= 0;
1069 warnings_not_errors
= 0;
1073 /* Tests the state of error_flag. */
1076 gfc_error_flag_test (void)
1078 return error_buffer
.flag
;
1082 /* Check to see if any errors have been saved.
1083 If so, print the error. Returns the state of error_flag. */
1086 gfc_error_check (void)
1090 rc
= error_buffer
.flag
;
1092 if (error_buffer
.flag
)
1094 if (error_buffer
.message
!= NULL
)
1095 fputs (error_buffer
.message
, stderr
);
1096 error_buffer
.flag
= 0;
1098 gfc_increment_error_count();
1100 if (flag_fatal_errors
)
1101 exit (FATAL_EXIT_CODE
);
1108 /* Save the existing error state. */
1111 gfc_push_error (gfc_error_buf
*err
)
1113 err
->flag
= error_buffer
.flag
;
1114 if (error_buffer
.flag
)
1115 err
->message
= xstrdup (error_buffer
.message
);
1117 error_buffer
.flag
= 0;
1121 /* Restore a previous pushed error state. */
1124 gfc_pop_error (gfc_error_buf
*err
)
1126 error_buffer
.flag
= err
->flag
;
1127 if (error_buffer
.flag
)
1129 size_t len
= strlen (err
->message
) + 1;
1130 gcc_assert (len
<= error_buffer
.allocated
);
1131 memcpy (error_buffer
.message
, err
->message
, len
);
1132 free (err
->message
);
1137 /* Free a pushed error state, but keep the current error state. */
1140 gfc_free_error (gfc_error_buf
*err
)
1143 free (err
->message
);
1147 /* Report the number of warnings and errors that occurred to the caller. */
1150 gfc_get_errors (int *w
, int *e
)
1159 /* Switch errors into warnings. */
1162 gfc_errors_to_warnings (int f
)
1164 warnings_not_errors
= (f
== 1) ? 1 : 0;