PR fortran/36160
[official-gcc.git] / gcc / fortran / error.c
bloba8c2b63a6d989b83b307c3b6866db2ca48879e86
1 /* Handle errors.
2 Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
3 2010
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
12 version.
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
17 for more details.
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. */
29 #include "config.h"
30 #include "system.h"
31 #include "flags.h"
32 #include "gfortran.h"
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. */
45 void
46 gfc_push_suppress_errors (void)
48 gcc_assert (suppress_errors >= 0);
49 ++suppress_errors;
53 /* Leave one level of error suppressing. */
55 void
56 gfc_pop_suppress_errors (void)
58 gcc_assert (suppress_errors > 0);
59 --suppress_errors;
63 /* Per-file error initialization. */
65 void
66 gfc_error_init_1 (void)
68 terminal_width = gfc_terminal_width ();
69 errors = 0;
70 warnings = 0;
71 buffer_flag = 0;
75 /* Set the flag for buffering errors or not. */
77 void
78 gfc_buffer_error (int flag)
80 buffer_flag = flag;
84 /* Add a single character to the error buffer or output depending on
85 buffer_flag. */
87 static void
88 error_char (char c)
90 if (buffer_flag)
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;
101 else
103 if (c != 0)
105 /* We build up complete lines before handing things
106 over to the library in order to speed up error printing. */
107 static char *line;
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);
115 line[index++] = c;
116 if (c == '\n')
118 line[index] = '\0';
119 fputs (line, stderr);
120 index = 0;
127 /* Copy a string to wherever it needs to go. */
129 static void
130 error_string (const char *p)
132 while (*p)
133 error_char (*p++);
137 /* Print a formatted integer to the error buffer or output. */
139 #define IBUF_LEN 60
141 static void
142 error_uinteger (unsigned long int i)
144 char *p, int_buf[IBUF_LEN];
146 p = int_buf + IBUF_LEN - 1;
147 *p-- = '\0';
149 if (i == 0)
150 *p-- = '0';
152 while (i > 0)
154 *p-- = i % 10 + '0';
155 i = i / 10;
158 error_string (p + 1);
161 static void
162 error_integer (long int i)
164 unsigned long int u;
166 if (i < 0)
168 u = (unsigned long int) -i;
169 error_char ('-');
171 else
172 u = i;
174 error_uinteger (u);
178 static size_t
179 gfc_widechar_display_length (gfc_char_t c)
181 if (gfc_wide_is_printable (c))
182 /* Simple ASCII character */
183 return 1;
184 else if (c < ((gfc_char_t) 1 << 8))
185 /* Displayed as \x?? */
186 return 4;
187 else if (c < ((gfc_char_t) 1 << 16))
188 /* Displayed as \u???? */
189 return 6;
190 else
191 /* Displayed as \U???????? */
192 return 10;
196 /* Length of the ASCII representation of the wide string, escaping wide
197 characters as print_wide_char_into_buffer() does. */
199 static size_t
200 gfc_wide_display_length (const gfc_char_t *str)
202 size_t i, len;
204 for (i = 0, len = 0; str[i]; i++)
205 len += gfc_widechar_display_length (str[i]);
207 return len;
210 static int
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))
218 buf[1] = '\0';
219 buf[0] = (unsigned char) c;
220 return 1;
222 else if (c < ((gfc_char_t) 1 << 8))
224 buf[4] = '\0';
225 buf[3] = xdigit[c & 0x0F];
226 c = c >> 4;
227 buf[2] = xdigit[c & 0x0F];
229 buf[1] = 'x';
230 buf[0] = '\\';
231 return 4;
233 else if (c < ((gfc_char_t) 1 << 16))
235 buf[6] = '\0';
236 buf[5] = xdigit[c & 0x0F];
237 c = c >> 4;
238 buf[4] = xdigit[c & 0x0F];
239 c = c >> 4;
240 buf[3] = xdigit[c & 0x0F];
241 c = c >> 4;
242 buf[2] = xdigit[c & 0x0F];
244 buf[1] = 'u';
245 buf[0] = '\\';
246 return 6;
248 else
250 buf[10] = '\0';
251 buf[9] = xdigit[c & 0x0F];
252 c = c >> 4;
253 buf[8] = xdigit[c & 0x0F];
254 c = c >> 4;
255 buf[7] = xdigit[c & 0x0F];
256 c = c >> 4;
257 buf[6] = xdigit[c & 0x0F];
258 c = c >> 4;
259 buf[5] = xdigit[c & 0x0F];
260 c = c >> 4;
261 buf[4] = xdigit[c & 0x0F];
262 c = c >> 4;
263 buf[3] = xdigit[c & 0x0F];
264 c = c >> 4;
265 buf[2] = xdigit[c & 0x0F];
267 buf[1] = 'U';
268 buf[0] = '\\';
269 return 10;
273 static char wide_char_print_buffer[11];
275 const char *
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);
289 static void
290 show_locus (locus *loc, int c1, int c2)
292 gfc_linebuf *lb;
293 gfc_file *f;
294 gfc_char_t c, *p;
295 int i, offset, cmax;
297 /* TODO: Either limit the total length and number of included files
298 displayed or add buffering of arbitrary number of characters in
299 error messages. */
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. */
307 lb = loc->lb;
308 f = lb->file;
310 error_string (f->filename);
311 error_char (':');
313 error_integer (LOCATION_LINE (lb->location));
315 if ((c1 > 0) || (c2 > 0))
316 error_char ('.');
318 if (c1 > 0)
319 error_integer (c1);
321 if ((c1 > 0) && (c2 > 0))
322 error_char ('-');
324 if (c2 > 0)
325 error_integer (c2);
327 error_char (':');
328 error_char ('\n');
330 for (;;)
332 i = f->inclusion_line;
334 f = f->up;
335 if (f == NULL) break;
337 error_printf (" Included at %s:%d:", f->filename, i);
340 error_char ('\n');
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. */
347 offset = 0;
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. */
354 if (c1 == c2)
355 c2 += 1;
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;
370 while (i > 0)
372 static char buffer[11];
374 c = *p++;
375 if (c == '\t')
376 c = ' ';
378 i -= print_wide_char_into_buffer (c, buffer);
379 error_string (buffer);
382 error_char ('\n');
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. */
388 c1 -= offset;
389 c2 -= offset;
391 p = &(lb->line[offset]);
392 for (i = 0; i <= cmax; i++)
394 int spaces, j;
395 spaces = gfc_widechar_display_length (*p++);
397 if (i == c1)
398 error_char ('1'), spaces--;
399 else if (i == c2)
400 error_char ('2'), spaces--;
402 for (j = 0; j < spaces; j++)
403 error_char (' ');
406 error_char ('\n');
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. */
415 static void
416 show_loci (locus *l1, locus *l2)
418 int m, c1, c2;
420 if (l1 == NULL || l1->lb == NULL)
422 error_printf ("<During initialization>\n");
423 return;
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;
431 if (l2 == NULL)
433 show_locus (l1, c1, -1);
434 return;
437 c2 = l2->nextc - l2->lb->line;
439 if (c1 < c2)
440 m = c2 - c1;
441 else
442 m = c1 - c2;
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);
451 return;
454 show_locus (l1, c1, c2);
456 return;
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. */
480 #define MAX_ARGS 10
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,
487 NOTYPE };
488 struct
490 int type;
491 int pos;
492 union
494 int intval;
495 unsigned int uintval;
496 long int longintval;
497 unsigned long int ulongintval;
498 char charval;
499 const char * stringval;
500 } u;
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. */
506 char c;
507 int i, n, have_l1, pos, maxpos;
508 locus *l1, *l2, *loc;
509 const char *format;
511 loc = l1 = l2 = NULL;
513 have_l1 = 0;
514 pos = -1;
515 maxpos = -1;
517 n = 0;
518 format = format0;
520 for (i = 0; i < MAX_ARGS; i++)
522 arg[i].type = NOTYPE;
523 spec[i].pos = -1;
526 /* First parse the format string for position specifiers. */
527 while (*format)
529 c = *format++;
530 if (c != '%')
531 continue;
533 if (*format == '%')
535 format++;
536 continue;
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))
548 format++;
549 gcc_assert (*format++ == '$');
551 else
552 pos++;
554 c = *format++;
556 if (pos > maxpos)
557 maxpos = pos;
559 switch (c)
561 case 'C':
562 arg[pos].type = TYPE_CURRENTLOC;
563 break;
565 case 'L':
566 arg[pos].type = TYPE_LOCUS;
567 break;
569 case 'd':
570 case 'i':
571 arg[pos].type = TYPE_INTEGER;
572 break;
574 case 'u':
575 arg[pos].type = TYPE_UINTEGER;
576 break;
578 case 'l':
579 c = *format++;
580 if (c == 'u')
581 arg[pos].type = TYPE_ULONGINT;
582 else if (c == 'i' || c == 'd')
583 arg[pos].type = TYPE_LONGINT;
584 else
585 gcc_unreachable ();
586 break;
588 case 'c':
589 arg[pos].type = TYPE_CHAR;
590 break;
592 case 's':
593 arg[pos].type = TYPE_STRING;
594 break;
596 default:
597 gcc_unreachable ();
600 spec[n++].pos = pos;
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;
611 /* Fall through. */
613 case TYPE_LOCUS:
614 if (arg[pos].type == TYPE_LOCUS)
615 loc = va_arg (argp, locus *);
617 if (have_l1)
619 l2 = loc;
620 arg[pos].u.stringval = "(2)";
622 else
624 l1 = loc;
625 have_l1 = 1;
626 arg[pos].u.stringval = "(1)";
628 break;
630 case TYPE_INTEGER:
631 arg[pos].u.intval = va_arg (argp, int);
632 break;
634 case TYPE_UINTEGER:
635 arg[pos].u.uintval = va_arg (argp, unsigned int);
636 break;
638 case TYPE_LONGINT:
639 arg[pos].u.longintval = va_arg (argp, long int);
640 break;
642 case TYPE_ULONGINT:
643 arg[pos].u.ulongintval = va_arg (argp, unsigned long int);
644 break;
646 case TYPE_CHAR:
647 arg[pos].u.charval = (char) va_arg (argp, int);
648 break;
650 case TYPE_STRING:
651 arg[pos].u.stringval = (const char *) va_arg (argp, char *);
652 break;
654 default:
655 gcc_unreachable ();
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. */
663 if (have_l1)
664 show_loci (l1, l2);
666 if (*type)
668 error_string (type);
669 error_char (' ');
672 have_l1 = 0;
673 format = format0;
674 n = 0;
676 for (; *format; format++)
678 if (*format != '%')
680 error_char (*format);
681 continue;
684 format++;
685 if (ISDIGIT (*format))
687 /* This is a position specifier. See comment above. */
688 while (ISDIGIT (*format))
689 format++;
691 /* Skip over the dollar sign. */
692 format++;
695 switch (*format)
697 case '%':
698 error_char ('%');
699 break;
701 case 'c':
702 error_char (spec[n++].u.charval);
703 break;
705 case 's':
706 case 'C': /* Current locus */
707 case 'L': /* Specified locus */
708 error_string (spec[n++].u.stringval);
709 break;
711 case 'd':
712 case 'i':
713 error_integer (spec[n++].u.intval);
714 break;
716 case 'u':
717 error_uinteger (spec[n++].u.uintval);
718 break;
720 case 'l':
721 format++;
722 if (*format == 'u')
723 error_uinteger (spec[n++].u.ulongintval);
724 else
725 error_integer (spec[n++].u.longintval);
726 break;
731 error_char ('\n');
735 /* Wrapper for error_print(). */
737 static void
738 error_printf (const char *gmsgid, ...)
740 va_list argp;
742 va_start (argp, gmsgid);
743 error_print ("", _(gmsgid), argp);
744 va_end (argp);
748 /* Increment the number of errors, and check whether too many have
749 been printed. */
751 static void
752 gfc_increment_error_count (void)
754 errors++;
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. */
762 void
763 gfc_warning (const char *gmsgid, ...)
765 va_list argp;
767 if (inhibit_warnings)
768 return;
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);
776 va_end (argp);
778 error_char ('\0');
780 if (buffer_flag == 0)
782 warnings++;
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. */
792 notification
793 gfc_notification_std (int std)
795 bool warning;
797 warning = ((gfc_option.warn_std & std) != 0) && !inhibit_warnings;
798 if ((gfc_option.allow_std & std) != 0 && !warning)
799 return SILENT;
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. */
810 gfc_try
811 gfc_notify_std (int std, const char *gmsgid, ...)
813 va_list argp;
814 bool warning;
816 warning = ((gfc_option.warn_std & std) != 0) && !inhibit_warnings;
817 if ((gfc_option.allow_std & std) != 0 && !warning)
818 return SUCCESS;
820 if (suppress_errors)
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);
828 if (warning)
829 error_print (_("Warning:"), _(gmsgid), argp);
830 else
831 error_print (_("Error:"), _(gmsgid), argp);
832 va_end (argp);
834 error_char ('\0');
836 if (buffer_flag == 0)
838 if (warning && !warnings_are_errors)
839 warnings++;
840 else
841 gfc_increment_error_count();
844 return (warning && !warnings_are_errors) ? SUCCESS : FAILURE;
848 /* Immediate warning (i.e. do not buffer the warning). */
850 void
851 gfc_warning_now (const char *gmsgid, ...)
853 va_list argp;
854 int i;
856 if (inhibit_warnings)
857 return;
859 i = buffer_flag;
860 buffer_flag = 0;
861 warnings++;
863 va_start (argp, gmsgid);
864 error_print (_("Warning:"), _(gmsgid), argp);
865 va_end (argp);
867 error_char ('\0');
869 if (warnings_are_errors)
870 gfc_increment_error_count();
872 buffer_flag = i;
876 /* Clear the warning flag. */
878 void
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. */
888 void
889 gfc_warning_check (void)
891 if (warning_buffer.flag)
893 warnings++;
894 if (warning_buffer.message != NULL)
895 fputs (warning_buffer.message, stderr);
896 warning_buffer.flag = 0;
901 /* Issue an error. */
903 void
904 gfc_error (const char *gmsgid, ...)
906 va_list argp;
908 if (warnings_not_errors)
909 goto warning;
911 if (suppress_errors)
912 return;
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);
920 va_end (argp);
922 error_char ('\0');
924 if (buffer_flag == 0)
925 gfc_increment_error_count();
927 return;
929 warning:
931 if (inhibit_warnings)
932 return;
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);
940 va_end (argp);
942 error_char ('\0');
944 if (buffer_flag == 0)
946 warnings++;
947 if (warnings_are_errors)
948 gfc_increment_error_count();
953 /* Immediate error. */
955 void
956 gfc_error_now (const char *gmsgid, ...)
958 va_list argp;
959 int i;
961 error_buffer.flag = 1;
962 error_buffer.index = 0;
963 cur_error_buffer = &error_buffer;
965 i = buffer_flag;
966 buffer_flag = 0;
968 va_start (argp, gmsgid);
969 error_print (_("Error:"), _(gmsgid), argp);
970 va_end (argp);
972 error_char ('\0');
974 gfc_increment_error_count();
976 buffer_flag = i;
978 if (flag_fatal_errors)
979 exit (FATAL_EXIT_CODE);
983 /* Fatal error, never returns. */
985 void
986 gfc_fatal_error (const char *gmsgid, ...)
988 va_list argp;
990 buffer_flag = 0;
992 va_start (argp, gmsgid);
993 error_print (_("Fatal Error:"), _(gmsgid), argp);
994 va_end (argp);
996 exit (FATAL_EXIT_CODE);
1000 /* This shouldn't happen... but sometimes does. */
1002 void
1003 gfc_internal_error (const char *format, ...)
1005 va_list argp;
1007 buffer_flag = 0;
1009 va_start (argp, format);
1011 show_loci (&gfc_current_locus, NULL);
1012 error_printf ("Internal Error at (1):");
1014 error_print ("", format, argp);
1015 va_end (argp);
1017 exit (ICE_EXIT_CODE);
1021 /* Clear the error flag when we start to compile a source line. */
1023 void
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)
1046 int rc;
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);
1062 return rc;
1066 /* Save the existing error state. */
1068 void
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. */
1081 void
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. */
1097 void
1098 gfc_free_error (gfc_error_buf *err)
1100 if (err->flag)
1101 free (err->message);
1105 /* Report the number of warnings and errors that occurred to the caller. */
1107 void
1108 gfc_get_errors (int *w, int *e)
1110 if (w != NULL)
1111 *w = warnings;
1112 if (e != NULL)
1113 *e = errors;
1117 /* Switch errors into warnings. */
1119 void
1120 gfc_errors_to_warnings (int f)
1122 warnings_not_errors = (f == 1) ? 1 : 0;