OSDN Git Service

3f38c3b68020d733260e7c18728d6cae6005d5ed
[pf3gnuchains/gcc-fork.git] / gcc / fortran / error.c
1 /* Handle errors.
2    Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation,
3    Inc.
4    Contributed by Andy Vaught & Niels Kristian Bech Jensen
5
6 This file is part of GCC.
7
8 GCC is free software; you can redistribute it and/or modify it under
9 the terms of the GNU General Public License as published by the Free
10 Software Foundation; either version 2, or (at your option) any later
11 version.
12
13 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
14 WARRANTY; without even the implied warranty of MERCHANTABILITY or
15 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
16 for more details.
17
18 You should have received a copy of the GNU General Public License
19 along with GCC; see the file COPYING.  If not, write to the Free
20 Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
21 02110-1301, USA.  */
22
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.  */
28
29 #include "config.h"
30 #include "system.h"
31 #include "flags.h"
32 #include "gfortran.h"
33
34 int gfc_suppress_error = 0;
35
36 static int terminal_width, buffer_flag, errors, warnings;
37
38 static gfc_error_buf error_buffer, warning_buffer, *cur_error_buffer;
39
40
41 /* Per-file error initialization.  */
42
43 void
44 gfc_error_init_1 (void)
45 {
46   terminal_width = gfc_terminal_width ();
47   errors = 0;
48   warnings = 0;
49   buffer_flag = 0;
50 }
51
52
53 /* Set the flag for buffering errors or not.  */
54
55 void
56 gfc_buffer_error (int flag)
57 {
58   buffer_flag = flag;
59 }
60
61
62 /* Add a single character to the error buffer or output depending on
63    buffer_flag.  */
64
65 static void
66 error_char (char c)
67 {
68   if (buffer_flag)
69     {
70       if (cur_error_buffer->index >= cur_error_buffer->allocated)
71         {
72           cur_error_buffer->allocated =
73             cur_error_buffer->allocated
74             ? cur_error_buffer->allocated * 2 : 1000;
75           cur_error_buffer->message
76             = xrealloc (cur_error_buffer->message,
77                         cur_error_buffer->allocated);
78         }
79       cur_error_buffer->message[cur_error_buffer->index++] = c;
80     }
81   else
82     {
83       if (c != 0)
84         {
85           /* We build up complete lines before handing things
86              over to the library in order to speed up error printing.  */
87           static char *line;
88           static size_t allocated = 0, index = 0;
89
90           if (index + 1 >= allocated)
91             {
92               allocated = allocated ? allocated * 2 : 1000;
93               line = xrealloc (line, allocated);
94             }
95           line[index++] = c;
96           if (c == '\n')
97             {
98               line[index] = '\0';
99               fputs (line, stderr);
100               index = 0;
101             }
102         }
103     }
104 }
105
106
107 /* Copy a string to wherever it needs to go.  */
108
109 static void
110 error_string (const char *p)
111 {
112   while (*p)
113     error_char (*p++);
114 }
115
116
117 /* Show the file, where it was included and the source line, give a
118    locus.  Calls error_printf() recursively, but the recursion is at
119    most one level deep.  */
120
121 static void error_printf (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
122
123 static void
124 show_locus (int offset, locus * loc)
125 {
126   gfc_linebuf *lb;
127   gfc_file *f;
128   char c, *p;
129   int i, m;
130
131   /* TODO: Either limit the total length and number of included files
132      displayed or add buffering of arbitrary number of characters in
133      error messages.  */
134
135   lb = loc->lb;
136   f = lb->file;
137   error_printf ("In file %s:%d\n", f->filename,
138 #ifdef USE_MAPPED_LOCATION
139                 LOCATION_LINE (lb->location)
140 #else
141                 lb->linenum
142 #endif
143                 );
144
145   for (;;)
146     {
147       i = f->inclusion_line;
148
149       f = f->included_by;
150       if (f == NULL) break;
151
152       error_printf ("    Included at %s:%d\n", f->filename, i);
153     }
154
155   /* Show the line itself, taking care not to print more than what can
156      show up on the terminal.  Tabs are converted to spaces.  */
157
158   p = lb->line + offset;
159   i = strlen (p);
160   if (i > terminal_width)
161     i = terminal_width - 1;
162
163   for (; i > 0; i--)
164     {
165       c = *p++;
166       if (c == '\t')
167         c = ' ';
168
169       if (ISPRINT (c))
170         error_char (c);
171       else
172         {
173           error_char ('\\');
174           error_char ('x');
175
176           m = ((c >> 4) & 0x0F) + '0';
177           if (m > '9')
178             m += 'A' - '9' - 1;
179           error_char (m);
180
181           m = (c & 0x0F) + '0';
182           if (m > '9')
183             m += 'A' - '9' - 1;
184           error_char (m);
185         }
186     }
187
188   error_char ('\n');
189 }
190
191
192 /* As part of printing an error, we show the source lines that caused
193    the problem.  We show at least one, possibly two loci.  If we're
194    showing two loci and they both refer to the same file and line, we
195    only print the line once.  */
196
197 static void
198 show_loci (locus * l1, locus * l2)
199 {
200   int offset, flag, i, m, c1, c2, cmax;
201
202   if (l1 == NULL)
203     {
204       error_printf ("<During initialization>\n");
205       return;
206     }
207
208   c1 = l1->nextc - l1->lb->line;
209   c2 = 0;
210   if (l2 == NULL)
211     goto separate;
212
213   c2 = l2->nextc - l2->lb->line;
214
215   if (c1 < c2)
216     m = c2 - c1;
217   else
218     m = c1 - c2;
219
220
221   if (l1->lb != l2->lb || m > terminal_width - 10)
222     goto separate;
223
224   offset = 0;
225   cmax = (c1 < c2) ? c2 : c1;
226   if (cmax > terminal_width - 5)
227     offset = cmax - terminal_width + 5;
228
229   if (offset < 0)
230     offset = 0;
231
232   c1 -= offset;
233   c2 -= offset;
234
235   show_locus (offset, l1);
236
237   /* Arrange that '1' and '2' will show up even if the two columns are equal.  */
238   for (i = 1; i <= cmax; i++)
239     {
240       flag = 0;
241       if (i == c1)
242         {
243           error_char ('1');
244           flag = 1;
245         }
246       if (i == c2)
247         {
248           error_char ('2');
249           flag = 1;
250         }
251       if (flag == 0)
252         error_char (' ');
253     }
254
255   error_char ('\n');
256
257   return;
258
259 separate:
260   offset = 0;
261
262   if (c1 > terminal_width - 5)
263     {
264       offset = c1 - 5;
265       if (offset < 0)
266         offset = 0;
267       c1 = c1 - offset;
268     }
269
270   show_locus (offset, l1);
271   for (i = 1; i < c1; i++)
272     error_char (' ');
273
274   error_char ('1');
275   error_char ('\n');
276
277   if (l2 != NULL)
278     {
279       offset = 0;
280
281       if (c2 > terminal_width - 20)
282         {
283           offset = c2 - 20;
284           if (offset < 0)
285             offset = 0;
286           c2 = c2 - offset;
287         }
288
289       show_locus (offset, l2);
290
291       for (i = 1; i < c2; i++)
292         error_char (' ');
293
294       error_char ('2');
295       error_char ('\n');
296     }
297 }
298
299
300 /* Workhorse for the error printing subroutines.  This subroutine is
301    inspired by g77's error handling and is similar to printf() with
302    the following %-codes:
303
304    %c Character, %d Integer, %s String, %% Percent
305    %L  Takes locus argument
306    %C  Current locus (no argument)
307
308    If a locus pointer is given, the actual source line is printed out
309    and the column is indicated.  Since we want the error message at
310    the bottom of any source file information, we must scan the
311    argument list twice.  A maximum of two locus arguments are
312    permitted.  */
313
314 #define IBUF_LEN 30
315 #define MAX_ARGS 10
316
317 static void ATTRIBUTE_GCC_GFC(2,0)
318 error_print (const char *type, const char *format0, va_list argp)
319 {
320   char c, *p, int_buf[IBUF_LEN], c_arg[MAX_ARGS], *cp_arg[MAX_ARGS];
321   int i, n, have_l1, i_arg[MAX_ARGS];
322   locus *l1, *l2, *loc;
323   const char *format;
324
325   l1 = l2 = loc = NULL;
326
327   have_l1 = 0;
328
329   n = 0;
330   format = format0;
331
332   while (*format)
333     {
334       c = *format++;
335       if (c == '%')
336         {
337           c = *format++;
338
339           switch (c)
340             {
341             case '%':
342               break;
343
344             case 'L':
345               loc = va_arg (argp, locus *);
346               /* Fall through */
347
348             case 'C':
349               if (c == 'C')
350                 loc = &gfc_current_locus;
351
352               if (have_l1)
353                 {
354                   l2 = loc;
355                 }
356               else
357                 {
358                   l1 = loc;
359                   have_l1 = 1;
360                 }
361               break;
362
363             case 'd':
364             case 'i':
365               i_arg[n++] = va_arg (argp, int);
366               break;
367
368             case 'c':
369               c_arg[n++] = va_arg (argp, int);
370               break;
371
372             case 's':
373               cp_arg[n++] = va_arg (argp, char *);
374               break;
375             }
376         }
377     }
378
379   /* Show the current loci if we have to.  */
380   if (have_l1)
381     show_loci (l1, l2);
382   error_string (type);
383   error_char (' ');
384
385   have_l1 = 0;
386   format = format0;
387   n = 0;
388
389   for (; *format; format++)
390     {
391       if (*format != '%')
392         {
393           error_char (*format);
394           continue;
395         }
396
397       format++;
398       switch (*format)
399         {
400         case '%':
401           error_char ('%');
402           break;
403
404         case 'c':
405           error_char (c_arg[n++]);
406           break;
407
408         case 's':
409           error_string (cp_arg[n++]);
410           break;
411
412         case 'i':
413         case 'd':
414           i = i_arg[n++];
415
416           if (i < 0)
417             {
418               i = -i;
419               error_char ('-');
420             }
421
422           p = int_buf + IBUF_LEN - 1;
423           *p-- = '\0';
424
425           if (i == 0)
426             *p-- = '0';
427
428           while (i > 0)
429             {
430               *p-- = i % 10 + '0';
431               i = i / 10;
432             }
433
434           error_string (p + 1);
435           break;
436
437         case 'C':               /* Current locus */
438         case 'L':               /* Specified locus */
439           error_string (have_l1 ? "(2)" : "(1)");
440           have_l1 = 1;
441           break;
442         }
443     }
444
445   error_char ('\n');
446 }
447
448
449 /* Wrapper for error_print().  */
450
451 static void
452 error_printf (const char *nocmsgid, ...)
453 {
454   va_list argp;
455
456   va_start (argp, nocmsgid);
457   error_print ("", _(nocmsgid), argp);
458   va_end (argp);
459 }
460
461
462 /* Issue a warning.  */
463
464 void
465 gfc_warning (const char *nocmsgid, ...)
466 {
467   va_list argp;
468
469   if (inhibit_warnings)
470     return;
471
472   warning_buffer.flag = 1;
473   warning_buffer.index = 0;
474   cur_error_buffer = &warning_buffer;
475
476   va_start (argp, nocmsgid);
477   if (buffer_flag == 0)
478     warnings++;
479   error_print (_("Warning:"), _(nocmsgid), argp);
480   va_end (argp);
481
482   error_char ('\0');
483 }
484
485
486 /* Possibly issue a warning/error about use of a nonstandard (or deleted)
487    feature.  An error/warning will be issued if the currently selected
488    standard does not contain the requested bits.  Return FAILURE if
489    an error is generated.  */
490
491 try
492 gfc_notify_std (int std, const char *nocmsgid, ...)
493 {
494   va_list argp;
495   bool warning;
496
497   warning = ((gfc_option.warn_std & std) != 0)
498             && !inhibit_warnings;
499   if ((gfc_option.allow_std & std) != 0
500       && !warning)
501     return SUCCESS;
502
503   if (gfc_suppress_error)
504     return warning ? SUCCESS : FAILURE;
505   
506   cur_error_buffer = warning ? &warning_buffer : &error_buffer;
507   cur_error_buffer->flag = 1;
508   cur_error_buffer->index = 0;
509
510   if (buffer_flag == 0)
511     {
512       if (warning)
513         warnings++;
514       else
515         errors++;
516     }
517   va_start (argp, nocmsgid);
518   if (warning)
519     error_print (_("Warning:"), _(nocmsgid), argp);
520   else
521     error_print (_("Error:"), _(nocmsgid), argp);
522   va_end (argp);
523
524   error_char ('\0');
525   return warning ? SUCCESS : FAILURE;
526 }
527
528
529 /* Immediate warning (i.e. do not buffer the warning).  */
530
531 void
532 gfc_warning_now (const char *nocmsgid, ...)
533 {
534   va_list argp;
535   int i;
536
537   if (inhibit_warnings)
538     return;
539
540   i = buffer_flag;
541   buffer_flag = 0;
542   warnings++;
543
544   va_start (argp, nocmsgid);
545   error_print (_("Warning:"), _(nocmsgid), argp);
546   va_end (argp);
547
548   error_char ('\0');
549   buffer_flag = i;
550 }
551
552
553 /* Clear the warning flag.  */
554
555 void
556 gfc_clear_warning (void)
557 {
558   warning_buffer.flag = 0;
559 }
560
561
562 /* Check to see if any warnings have been saved.
563    If so, print the warning.  */
564
565 void
566 gfc_warning_check (void)
567 {
568   if (warning_buffer.flag)
569     {
570       warnings++;
571       if (warning_buffer.message != NULL)
572         fputs (warning_buffer.message, stderr);
573       warning_buffer.flag = 0;
574     }
575 }
576
577
578 /* Issue an error.  */
579
580 void
581 gfc_error (const char *nocmsgid, ...)
582 {
583   va_list argp;
584
585   if (gfc_suppress_error)
586     return;
587
588   error_buffer.flag = 1;
589   error_buffer.index = 0;
590   cur_error_buffer = &error_buffer;
591
592   va_start (argp, nocmsgid);
593   if (buffer_flag == 0)
594     errors++;
595   error_print (_("Error:"), _(nocmsgid), argp);
596   va_end (argp);
597
598   error_char ('\0');
599 }
600
601
602 /* Immediate error.  */
603
604 void
605 gfc_error_now (const char *nocmsgid, ...)
606 {
607   va_list argp;
608   int i;
609
610   error_buffer.flag = 1;
611   error_buffer.index = 0;
612   cur_error_buffer = &error_buffer;
613
614   i = buffer_flag;
615   buffer_flag = 0;
616   errors++;
617
618   va_start (argp, nocmsgid);
619   error_print (_("Error:"), _(nocmsgid), argp);
620   va_end (argp);
621
622   error_char ('\0');
623   buffer_flag = i;
624 }
625
626
627 /* Fatal error, never returns.  */
628
629 void
630 gfc_fatal_error (const char *nocmsgid, ...)
631 {
632   va_list argp;
633
634   buffer_flag = 0;
635
636   va_start (argp, nocmsgid);
637   error_print (_("Fatal Error:"), _(nocmsgid), argp);
638   va_end (argp);
639
640   exit (3);
641 }
642
643
644 /* This shouldn't happen... but sometimes does.  */
645
646 void
647 gfc_internal_error (const char *format, ...)
648 {
649   va_list argp;
650
651   buffer_flag = 0;
652
653   va_start (argp, format);
654
655   show_loci (&gfc_current_locus, NULL);
656   error_printf ("Internal Error at (1):");
657
658   error_print ("", format, argp);
659   va_end (argp);
660
661   exit (4);
662 }
663
664
665 /* Clear the error flag when we start to compile a source line.  */
666
667 void
668 gfc_clear_error (void)
669 {
670   error_buffer.flag = 0;
671 }
672
673
674 /* Check to see if any errors have been saved.
675    If so, print the error.  Returns the state of error_flag.  */
676
677 int
678 gfc_error_check (void)
679 {
680   int rc;
681
682   rc = error_buffer.flag;
683
684   if (error_buffer.flag)
685     {
686       errors++;
687       if (error_buffer.message != NULL)
688         fputs (error_buffer.message, stderr);
689       error_buffer.flag = 0;
690     }
691
692   return rc;
693 }
694
695
696 /* Save the existing error state.  */
697
698 void
699 gfc_push_error (gfc_error_buf * err)
700 {
701   err->flag = error_buffer.flag;
702   if (error_buffer.flag)
703     err->message = xstrdup (error_buffer.message);
704
705   error_buffer.flag = 0;
706 }
707
708
709 /* Restore a previous pushed error state.  */
710
711 void
712 gfc_pop_error (gfc_error_buf * err)
713 {
714   error_buffer.flag = err->flag;
715   if (error_buffer.flag)
716     {
717       size_t len = strlen (err->message) + 1;
718       gcc_assert (len <= error_buffer.allocated);
719       memcpy (error_buffer.message, err->message, len);
720       gfc_free (err->message);
721     }
722 }
723
724
725 /* Free a pushed error state, but keep the current error state.  */
726
727 void
728 gfc_free_error (gfc_error_buf * err)
729 {
730   if (err->flag)
731     gfc_free (err->message);
732 }
733
734
735 /* Debug wrapper for printf.  */
736
737 void
738 gfc_status (const char *cmsgid, ...)
739 {
740   va_list argp;
741
742   va_start (argp, cmsgid);
743
744   vprintf (_(cmsgid), argp);
745
746   va_end (argp);
747 }
748
749
750 /* Subroutine for outputting a single char so that we don't have to go
751    around creating a lot of 1-character strings.  */
752
753 void
754 gfc_status_char (char c)
755 {
756   putchar (c);
757 }
758
759
760 /* Report the number of warnings and errors that occurred to the caller.  */
761
762 void
763 gfc_get_errors (int *w, int *e)
764 {
765   if (w != NULL)
766     *w = warnings;
767   if (e != NULL)
768     *e = errors;
769 }