2 Copyright (C) 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
3 Contributed by Andy Vaught & Niels Kristian Bech Jensen
5 This file is part of GNU G95.
7 GNU G95 is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU G95 is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU G95; see the file COPYING. If not, write to
19 the Free Software Foundation, 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
22 /* Handle the inevitable errors. A major catch here is that things
23 flagged as errors in one match subroutine can conceivably be legal
24 elsewhere. This means that error messages are recorded and saved
25 for possible use later. If a line does not match a legal
26 construction, then the saved error message is reported. */
39 int gfc_suppress_error = 0;
41 static int terminal_width, buffer_flag, errors,
42 use_warning_buffer, warnings;
44 static char *error_ptr, *warning_ptr;
46 static gfc_error_buf error_buffer, warning_buffer;
49 /* Per-file error initialization. */
52 gfc_error_init_1 (void)
55 terminal_width = gfc_terminal_width();
62 /* Set the flag for buffering errors or not. */
65 gfc_buffer_error (int flag)
72 /* Add a single character to the error buffer or output depending on
81 if (use_warning_buffer)
84 if (warning_ptr - warning_buffer.message >= MAX_ERROR_MESSAGE)
85 gfc_internal_error ("error_char(): Warning buffer overflow");
90 if (error_ptr - error_buffer.message >= MAX_ERROR_MESSAGE)
91 gfc_internal_error ("error_char(): Error buffer overflow");
102 /* Copy a string to wherever it needs to go. */
105 error_string (const char *p)
113 /* Show the file, where it was included and the source line give a
114 locus. Calls error_printf() recursively, but the recursion is at
115 most one level deep. */
117 static void error_printf (const char *, ...) ATTRIBUTE_PRINTF_1;
120 show_locus (int offset, locus * l)
126 /* TODO: Either limit the total length and number of included files
127 displayed or add buffering of arbitrary number of characters in
130 error_printf ("In file %s:%d\n", f->filename, l->lp->start_line + l->line);
135 error_printf (" Included at %s:%d\n", f->filename,
136 f->loc.lp->start_line + f->loc.line);
140 /* Show the line itself, taking care not to print more than what can
141 show up on the terminal. Tabs are converted to spaces. */
142 p = l->lp->line[l->line] + offset;
144 if (i > terminal_width)
145 i = terminal_width - 1;
160 m = ((c >> 4) & 0x0F) + '0';
165 m = (c & 0x0F) + '0';
176 /* As part of printing an error, we show the source lines that caused
177 the problem. We show at least one, possibly two loci. If we're
178 showing two loci and they both refer to the same file and line, we
179 only print the line once. */
182 show_loci (locus * l1, locus * l2)
184 int offset, flag, i, m, c1, c2, cmax;
188 error_printf ("<During initialization>\n");
192 c1 = l1->nextc - l1->lp->line[l1->line];
197 c2 = l2->nextc - l2->lp->line[l2->line];
205 if (l1->lp != l2->lp || l1->line != l2->line || m > terminal_width - 10)
209 cmax = (c1 < c2) ? c2 : c1;
210 if (cmax > terminal_width - 5)
211 offset = cmax - terminal_width + 5;
219 show_locus (offset, l1);
221 /* Arrange that '1' and '2' will show up even if the two columns are equal. */
222 for (i = 1; i <= cmax; i++)
246 if (c1 > terminal_width - 5)
254 show_locus (offset, l1);
255 for (i = 1; i < c1; i++)
265 if (c2 > terminal_width - 20)
273 show_locus (offset, l2);
275 for (i = 1; i < c2; i++)
284 /* Workhorse for the error printing subroutines. This subroutine is
285 inspired by g77's error handling and is similar to printf() with
286 the following %-codes:
288 %c Character, %d Integer, %s String, %% Percent
289 %L Takes locus argument
290 %C Current locus (no argument)
292 If a locus pointer is given, the actual source line is printed out
293 and the column is indicated. Since we want the error message at
294 the bottom of any source file information, we must scan the
295 argument list twice. A maximum of two locus arguments are
302 error_print (const char *type, const char *format0, va_list argp)
304 char c, *p, int_buf[IBUF_LEN], c_arg[MAX_ARGS], *cp_arg[MAX_ARGS];
305 int i, n, have_l1, i_arg[MAX_ARGS];
306 locus *l1, *l2, *loc;
309 l1 = l2 = loc = NULL;
329 loc = va_arg (argp, locus *);
334 loc = gfc_current_locus ();
349 i_arg[n++] = va_arg (argp, int);
353 c_arg[n++] = va_arg (argp, int);
357 cp_arg[n++] = va_arg (argp, char *);
363 /* Show the current loci if we have to. */
373 for (; *format; format++)
377 error_char (*format);
389 error_char (c_arg[n++]);
393 error_string (cp_arg[n++]);
406 p = int_buf + IBUF_LEN - 1;
418 error_string (p + 1);
421 case 'C': /* Current locus */
422 case 'L': /* Specified locus */
423 error_string (have_l1 ? "(2)" : "(1)");
433 /* Wrapper for error_print(). */
436 error_printf (const char *format, ...)
440 va_start (argp, format);
441 error_print ("", format, argp);
446 /* Issue a warning. */
449 gfc_warning (const char *format, ...)
453 if (inhibit_warnings)
456 warning_buffer.flag = 1;
457 warning_ptr = warning_buffer.message;
458 use_warning_buffer = 1;
460 va_start (argp, format);
461 if (buffer_flag == 0)
463 error_print ("Warning:", format, argp);
470 /* Possibly issue a warning/error about use of a nonstandard (or deleted)
471 feature. An error/warning will be issued if the currently selected
472 standard does not contain the requested bits. Return FAILURE if
473 and error is generated. */
476 gfc_notify_std (int std, const char *format, ...)
481 warning = ((gfc_option.warn_std & std) != 0)
482 && !inhibit_warnings;
483 if ((gfc_option.allow_std & std) != 0
487 if (gfc_suppress_error)
488 return warning ? SUCCESS : FAILURE;
492 warning_buffer.flag = 1;
493 warning_ptr = warning_buffer.message;
494 use_warning_buffer = 1;
498 error_buffer.flag = 1;
499 error_ptr = error_buffer.message;
500 use_warning_buffer = 0;
503 if (buffer_flag == 0)
510 va_start (argp, format);
512 error_print ("Warning:", format, argp);
514 error_print ("Error:", format, argp);
518 return warning ? SUCCESS : FAILURE;
522 /* Immediate warning (i.e. do not buffer the warning). */
525 gfc_warning_now (const char *format, ...)
530 if (inhibit_warnings)
537 va_start (argp, format);
538 error_print ("Warning:", format, argp);
546 /* Clear the warning flag. */
549 gfc_clear_warning (void)
552 warning_buffer.flag = 0;
556 /* Check to see if any warnings have been saved.
557 If so, print the warning. */
560 gfc_warning_check (void)
563 if (warning_buffer.flag)
566 fputs (warning_buffer.message, stderr);
567 warning_buffer.flag = 0;
572 /* Issue an error. */
575 gfc_error (const char *format, ...)
579 if (gfc_suppress_error)
582 error_buffer.flag = 1;
583 error_ptr = error_buffer.message;
584 use_warning_buffer = 0;
586 va_start (argp, format);
587 if (buffer_flag == 0)
589 error_print ("Error:", format, argp);
596 /* Immediate error. */
599 gfc_error_now (const char *format, ...)
604 error_buffer.flag = 1;
605 error_ptr = error_buffer.message;
611 va_start (argp, format);
612 error_print ("Error:", format, argp);
620 /* Fatal error, never returns. */
623 gfc_fatal_error (const char *format, ...)
629 va_start (argp, format);
630 error_print ("Fatal Error:", format, argp);
637 /* This shouldn't happen... but sometimes does. */
640 gfc_internal_error (const char *format, ...)
646 va_start (argp, format);
648 show_loci (gfc_current_locus (), NULL);
649 error_printf ("Internal Error at (1):");
651 error_print ("", format, argp);
658 /* Clear the error flag when we start to compile a source line. */
661 gfc_clear_error (void)
664 error_buffer.flag = 0;
668 /* Check to see if any errors have been saved.
669 If so, print the error. Returns the state of error_flag. */
672 gfc_error_check (void)
676 rc = error_buffer.flag;
678 if (error_buffer.flag)
681 fputs (error_buffer.message, stderr);
682 error_buffer.flag = 0;
689 /* Save the existing error state. */
692 gfc_push_error (gfc_error_buf * err)
695 err->flag = error_buffer.flag;
696 if (error_buffer.flag)
697 strcpy (err->message, error_buffer.message);
699 error_buffer.flag = 0;
703 /* Restore a previous pushed error state. */
706 gfc_pop_error (gfc_error_buf * err)
709 error_buffer.flag = err->flag;
710 if (error_buffer.flag)
711 strcpy (error_buffer.message, err->message);
715 /* Debug wrapper for printf. */
718 gfc_status (const char *format, ...)
722 va_start (argp, format);
724 vprintf (format, argp);
730 /* Subroutine for outputting a single char so that we don't have to go
731 around creating a lot of 1-character strings. */
734 gfc_status_char (char c)
740 /* Report the number of warnings and errors that occored to the caller. */
743 gfc_get_errors (int *w, int *e)