OSDN Git Service

24e54afeced94597bd3fe4d306c4e76bd0da47e7
[pf3gnuchains/gcc-fork.git] / gcc / fortran / error.c
1 /* Handle errors.
2    Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
3    Free Software Foundation, 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 3, 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 COPYING3.  If not see
20 <http://www.gnu.org/licenses/>.  */
21
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.  */
27
28 #include "config.h"
29 #include "system.h"
30 #include "flags.h"
31 #include "gfortran.h"
32
33 int gfc_suppress_error = 0;
34
35 static int terminal_width, buffer_flag, errors, warnings;
36
37 static gfc_error_buf error_buffer, warning_buffer, *cur_error_buffer;
38
39
40 /* Per-file error initialization.  */
41
42 void
43 gfc_error_init_1 (void)
44 {
45   terminal_width = gfc_terminal_width ();
46   errors = 0;
47   warnings = 0;
48   buffer_flag = 0;
49 }
50
51
52 /* Set the flag for buffering errors or not.  */
53
54 void
55 gfc_buffer_error (int flag)
56 {
57   buffer_flag = flag;
58 }
59
60
61 /* Add a single character to the error buffer or output depending on
62    buffer_flag.  */
63
64 static void
65 error_char (char c)
66 {
67   if (buffer_flag)
68     {
69       if (cur_error_buffer->index >= cur_error_buffer->allocated)
70         {
71           cur_error_buffer->allocated = cur_error_buffer->allocated
72                                       ? cur_error_buffer->allocated * 2 : 1000;
73           cur_error_buffer->message = xrealloc (cur_error_buffer->message,
74                                                 cur_error_buffer->allocated);
75         }
76       cur_error_buffer->message[cur_error_buffer->index++] = c;
77     }
78   else
79     {
80       if (c != 0)
81         {
82           /* We build up complete lines before handing things
83              over to the library in order to speed up error printing.  */
84           static char *line;
85           static size_t allocated = 0, index = 0;
86
87           if (index + 1 >= allocated)
88             {
89               allocated = allocated ? allocated * 2 : 1000;
90               line = xrealloc (line, allocated);
91             }
92           line[index++] = c;
93           if (c == '\n')
94             {
95               line[index] = '\0';
96               fputs (line, stderr);
97               index = 0;
98             }
99         }
100     }
101 }
102
103
104 /* Copy a string to wherever it needs to go.  */
105
106 static void
107 error_string (const char *p)
108 {
109   while (*p)
110     error_char (*p++);
111 }
112
113
114 /* Print a formatted integer to the error buffer or output.  */
115
116 #define IBUF_LEN 30
117
118 static void
119 error_integer (int i)
120 {
121   char *p, int_buf[IBUF_LEN];
122
123   if (i < 0)
124     {
125       i = -i;
126       error_char ('-');
127     }
128
129   p = int_buf + IBUF_LEN - 1;
130   *p-- = '\0';
131
132   if (i == 0)
133     *p-- = '0';
134
135   while (i > 0)
136     {
137       *p-- = i % 10 + '0';
138       i = i / 10;
139     }
140
141   error_string (p + 1);
142 }
143
144
145 /* Show the file, where it was included, and the source line, give a
146    locus.  Calls error_printf() recursively, but the recursion is at
147    most one level deep.  */
148
149 static void error_printf (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
150
151 static void
152 show_locus (locus *loc, int c1, int c2)
153 {
154   gfc_linebuf *lb;
155   gfc_file *f;
156   char c, *p;
157   int i, m, offset, cmax;
158
159   /* TODO: Either limit the total length and number of included files
160      displayed or add buffering of arbitrary number of characters in
161      error messages.  */
162
163   /* Write out the error header line, giving the source file and error
164      location (in GNU standard "[file]:[line].[column]:" format),
165      followed by an "included by" stack and a blank line.  This header
166      format is matched by a testsuite parser defined in
167      lib/gfortran-dg.exp.  */
168
169   lb = loc->lb;
170   f = lb->file;
171
172   error_string (f->filename);
173   error_char (':');
174     
175 #ifdef USE_MAPPED_LOCATION
176   error_integer (LOCATION_LINE (lb->location));
177 #else
178   error_integer (lb->linenum);
179 #endif
180
181   if ((c1 > 0) || (c2 > 0))
182     error_char ('.');
183
184   if (c1 > 0)
185     error_integer (c1);
186
187   if ((c1 > 0) && (c2 > 0))
188     error_char ('-');
189
190   if (c2 > 0)
191     error_integer (c2);
192
193   error_char (':');
194   error_char ('\n');
195
196   for (;;)
197     {
198       i = f->inclusion_line;
199
200       f = f->included_by;
201       if (f == NULL) break;
202
203       error_printf ("    Included at %s:%d:", f->filename, i);
204     }
205
206   error_char ('\n');
207
208   /* Calculate an appropriate horizontal offset of the source line in
209      order to get the error locus within the visible portion of the
210      line.  Note that if the margin of 5 here is changed, the
211      corresponding margin of 10 in show_loci should be changed.  */
212
213   offset = 0;
214
215   /* When the loci is not associated with a column, it will have a
216      value of zero.  We adjust this to 1 so that it will appear.  */
217      
218   if (c1 == 0)
219     c1 = 1;
220   if (c2 == 0)
221     c2 = 1;
222
223   /* If the two loci would appear in the same column, we shift
224      '2' one column to the right, so as to print '12' rather than
225      just '1'.  We do this here so it will be accounted for in the
226      margin calculations.  */
227
228   if (c1 == c2)
229     c2 += 1;
230
231   cmax = (c1 < c2) ? c2 : c1;
232   if (cmax > terminal_width - 5)
233     offset = cmax - terminal_width + 5;
234
235   /* Show the line itself, taking care not to print more than what can
236      show up on the terminal.  Tabs are converted to spaces, and 
237      nonprintable characters are converted to a "\xNN" sequence.  */
238
239   /* TODO: Although setting i to the terminal width is clever, it fails
240      to work correctly when nonprintable characters exist.  A better 
241      solution should be found.  */
242
243   p = lb->line + offset;
244   i = strlen (p);
245   if (i > terminal_width)
246     i = terminal_width - 1;
247
248   for (; i > 0; i--)
249     {
250       c = *p++;
251       if (c == '\t')
252         c = ' ';
253
254       if (ISPRINT (c))
255         error_char (c);
256       else
257         {
258           error_char ('\\');
259           error_char ('x');
260
261           m = ((c >> 4) & 0x0F) + '0';
262           if (m > '9')
263             m += 'A' - '9' - 1;
264           error_char (m);
265
266           m = (c & 0x0F) + '0';
267           if (m > '9')
268             m += 'A' - '9' - 1;
269           error_char (m);
270         }
271     }
272
273   error_char ('\n');
274
275   /* Show the '1' and/or '2' corresponding to the column of the error
276      locus.  Note that a value of -1 for c1 or c2 will simply cause 
277      the relevant number not to be printed.  */
278
279   c1 -= offset;
280   c2 -= offset;
281
282   for (i = 1; i <= cmax; i++)
283     {
284       if (i == c1)
285         error_char ('1');
286       else if (i == c2)
287         error_char ('2');
288       else
289         error_char (' ');
290     }
291
292   error_char ('\n');
293
294 }
295
296
297 /* As part of printing an error, we show the source lines that caused
298    the problem.  We show at least one, and possibly two loci; the two
299    loci may or may not be on the same source line.  */
300
301 static void
302 show_loci (locus *l1, locus *l2)
303 {
304   int m, c1, c2;
305
306   if (l1 == NULL || l1->lb == NULL)
307     {
308       error_printf ("<During initialization>\n");
309       return;
310     }
311
312   /* While calculating parameters for printing the loci, we consider possible
313      reasons for printing one per line.  If appropriate, print the loci
314      individually; otherwise we print them both on the same line.  */
315
316   c1 = l1->nextc - l1->lb->line;
317   if (l2 == NULL)
318     {
319       show_locus (l1, c1, -1);
320       return;
321     }
322
323   c2 = l2->nextc - l2->lb->line;
324
325   if (c1 < c2)
326     m = c2 - c1;
327   else
328     m = c1 - c2;
329
330   /* Note that the margin value of 10 here needs to be less than the 
331      margin of 5 used in the calculation of offset in show_locus.  */
332
333   if (l1->lb != l2->lb || m > terminal_width - 10)
334     {
335       show_locus (l1, c1, -1);
336       show_locus (l2, -1, c2);
337       return;
338     }
339
340   show_locus (l1, c1, c2);
341
342   return;
343 }
344
345
346 /* Workhorse for the error printing subroutines.  This subroutine is
347    inspired by g77's error handling and is similar to printf() with
348    the following %-codes:
349
350    %c Character, %d or %i Integer, %s String, %% Percent
351    %L  Takes locus argument
352    %C  Current locus (no argument)
353
354    If a locus pointer is given, the actual source line is printed out
355    and the column is indicated.  Since we want the error message at
356    the bottom of any source file information, we must scan the
357    argument list twice -- once to determine whether the loci are 
358    present and record this for printing, and once to print the error
359    message after and loci have been printed.  A maximum of two locus
360    arguments are permitted.
361    
362    This function is also called (recursively) by show_locus in the
363    case of included files; however, as show_locus does not resupply
364    any loci, the recursion is at most one level deep.  */
365
366 #define MAX_ARGS 10
367
368 static void ATTRIBUTE_GCC_GFC(2,0)
369 error_print (const char *type, const char *format0, va_list argp)
370 {
371   enum { TYPE_CURRENTLOC, TYPE_LOCUS, TYPE_INTEGER, TYPE_CHAR, TYPE_STRING,
372          NOTYPE };
373   struct
374   {
375     int type;
376     int pos;
377     union
378     {
379       int intval;
380       char charval;
381       const char * stringval;
382     } u;
383   } arg[MAX_ARGS], spec[MAX_ARGS];
384   /* spec is the array of specifiers, in the same order as they
385      appear in the format string.  arg is the array of arguments,
386      in the same order as they appear in the va_list.  */
387
388   char c;
389   int i, n, have_l1, pos, maxpos;
390   locus *l1, *l2, *loc;
391   const char *format;
392
393   l1 = l2 = NULL;
394
395   have_l1 = 0;
396   pos = -1;
397   maxpos = -1;
398
399   n = 0;
400   format = format0;
401
402   for (i = 0; i < MAX_ARGS; i++)
403     {
404       arg[i].type = NOTYPE;
405       spec[i].pos = -1;
406     }
407
408   /* First parse the format string for position specifiers.  */
409   while (*format)
410     {
411       c = *format++;
412       if (c != '%')
413         continue;
414
415       if (*format == '%')
416         {
417           format++;
418           continue;
419         }
420
421       if (ISDIGIT (*format))
422         {
423           /* This is a position specifier.  For example, the number
424              12 in the format string "%12$d", which specifies the third
425              argument of the va_list, formatted in %d format.
426              For details, see "man 3 printf".  */
427           pos = atoi(format) - 1;
428           gcc_assert (pos >= 0);
429           while (ISDIGIT(*format))
430             format++;
431           gcc_assert (*format++ == '$');
432         }
433       else
434         pos++;
435
436       c = *format++;
437
438       if (pos > maxpos)
439         maxpos = pos;
440
441       switch (c)
442         {
443           case 'C':
444             arg[pos].type = TYPE_CURRENTLOC;
445             break;
446
447           case 'L':
448             arg[pos].type = TYPE_LOCUS;
449             break;
450
451           case 'd':
452           case 'i':
453             arg[pos].type = TYPE_INTEGER;
454             break;
455
456           case 'c':
457             arg[pos].type = TYPE_CHAR;
458             break;
459
460           case 's':
461             arg[pos].type = TYPE_STRING;
462             break;
463
464           default:
465             gcc_unreachable ();
466         }
467
468       spec[n++].pos = pos;
469     }
470
471   /* Then convert the values for each %-style argument.  */
472   for (pos = 0; pos <= maxpos; pos++)
473     {
474       gcc_assert (arg[pos].type != NOTYPE);
475       switch (arg[pos].type)
476         {
477           case TYPE_CURRENTLOC:
478             loc = &gfc_current_locus;
479             /* Fall through.  */
480
481           case TYPE_LOCUS:
482             if (arg[pos].type == TYPE_LOCUS)
483               loc = va_arg (argp, locus *);
484
485             if (have_l1)
486               {
487                 l2 = loc;
488                 arg[pos].u.stringval = "(2)";
489               }
490             else
491               {
492                 l1 = loc;
493                 have_l1 = 1;
494                 arg[pos].u.stringval = "(1)";
495               }
496             break;
497
498           case TYPE_INTEGER:
499             arg[pos].u.intval = va_arg (argp, int);
500             break;
501
502           case TYPE_CHAR:
503             arg[pos].u.charval = (char) va_arg (argp, int);
504             break;
505
506           case TYPE_STRING:
507             arg[pos].u.stringval = (const char *) va_arg (argp, char *);
508             break;
509
510           default:
511             gcc_unreachable ();
512         }
513     }
514
515   for (n = 0; spec[n].pos >= 0; n++)
516     spec[n].u = arg[spec[n].pos].u;
517
518   /* Show the current loci if we have to.  */
519   if (have_l1)
520     show_loci (l1, l2);
521
522   if (*type)
523     {
524       error_string (type);
525       error_char (' ');
526     }
527
528   have_l1 = 0;
529   format = format0;
530   n = 0;
531
532   for (; *format; format++)
533     {
534       if (*format != '%')
535         {
536           error_char (*format);
537           continue;
538         }
539
540       format++;
541       if (ISDIGIT (*format))
542         {
543           /* This is a position specifier.  See comment above.  */
544           while (ISDIGIT (*format))
545             format++;
546             
547           /* Skip over the dollar sign.  */
548           format++;
549         }
550         
551       switch (*format)
552         {
553         case '%':
554           error_char ('%');
555           break;
556
557         case 'c':
558           error_char (spec[n++].u.charval);
559           break;
560
561         case 's':
562         case 'C':               /* Current locus */
563         case 'L':               /* Specified locus */
564           error_string (spec[n++].u.stringval);
565           break;
566
567         case 'd':
568         case 'i':
569           error_integer (spec[n++].u.intval);
570           break;
571         }
572     }
573
574   error_char ('\n');
575 }
576
577
578 /* Wrapper for error_print().  */
579
580 static void
581 error_printf (const char *nocmsgid, ...)
582 {
583   va_list argp;
584
585   va_start (argp, nocmsgid);
586   error_print ("", _(nocmsgid), argp);
587   va_end (argp);
588 }
589
590
591 /* Increment the number of errors, and check whether too many have 
592    been printed.  */
593
594 static void
595 gfc_increment_error_count (void)
596 {
597   errors++;
598   if ((gfc_option.max_errors != 0) && (errors >= gfc_option.max_errors))
599     gfc_fatal_error ("Error count reached limit of %d.", gfc_option.max_errors);
600 }
601
602
603 /* Issue a warning.  */
604
605 void
606 gfc_warning (const char *nocmsgid, ...)
607 {
608   va_list argp;
609
610   if (inhibit_warnings)
611     return;
612
613   warning_buffer.flag = 1;
614   warning_buffer.index = 0;
615   cur_error_buffer = &warning_buffer;
616
617   va_start (argp, nocmsgid);
618   error_print (_("Warning:"), _(nocmsgid), argp);
619   va_end (argp);
620
621   error_char ('\0');
622
623   if (buffer_flag == 0)
624   {
625     warnings++;
626     if (warnings_are_errors)
627       gfc_increment_error_count();
628   }
629 }
630
631
632 /* Whether, for a feature included in a given standard set (GFC_STD_*),
633    we should issue an error or a warning, or be quiet.  */
634
635 notification
636 gfc_notification_std (int std)
637 {
638   bool warning;
639
640   warning = ((gfc_option.warn_std & std) != 0) && !inhibit_warnings;
641   if ((gfc_option.allow_std & std) != 0 && !warning)
642     return SILENT;
643
644   return warning ? WARNING : ERROR;
645 }
646
647
648 /* Possibly issue a warning/error about use of a nonstandard (or deleted)
649    feature.  An error/warning will be issued if the currently selected
650    standard does not contain the requested bits.  Return FAILURE if
651    an error is generated.  */
652
653 try
654 gfc_notify_std (int std, const char *nocmsgid, ...)
655 {
656   va_list argp;
657   bool warning;
658
659   warning = ((gfc_option.warn_std & std) != 0) && !inhibit_warnings;
660   if ((gfc_option.allow_std & std) != 0 && !warning)
661     return SUCCESS;
662
663   if (gfc_suppress_error)
664     return warning ? SUCCESS : FAILURE;
665
666   cur_error_buffer = (warning && !warnings_are_errors)
667                    ? &warning_buffer : &error_buffer;
668   cur_error_buffer->flag = 1;
669   cur_error_buffer->index = 0;
670
671   va_start (argp, nocmsgid);
672   if (warning)
673     error_print (_("Warning:"), _(nocmsgid), argp);
674   else
675     error_print (_("Error:"), _(nocmsgid), argp);
676   va_end (argp);
677
678   error_char ('\0');
679
680   if (buffer_flag == 0)
681     {
682       if (warning && !warnings_are_errors)
683         warnings++;
684       else
685         gfc_increment_error_count();
686     }
687
688   return (warning && !warnings_are_errors) ? SUCCESS : FAILURE;
689 }
690
691
692 /* Immediate warning (i.e. do not buffer the warning).  */
693
694 void
695 gfc_warning_now (const char *nocmsgid, ...)
696 {
697   va_list argp;
698   int i;
699
700   if (inhibit_warnings)
701     return;
702
703   i = buffer_flag;
704   buffer_flag = 0;
705   warnings++;
706   if (warnings_are_errors)
707     gfc_increment_error_count();
708
709   va_start (argp, nocmsgid);
710   error_print (_("Warning:"), _(nocmsgid), argp);
711   va_end (argp);
712
713   error_char ('\0');
714   buffer_flag = i;
715 }
716
717
718 /* Clear the warning flag.  */
719
720 void
721 gfc_clear_warning (void)
722 {
723   warning_buffer.flag = 0;
724 }
725
726
727 /* Check to see if any warnings have been saved.
728    If so, print the warning.  */
729
730 void
731 gfc_warning_check (void)
732 {
733   if (warning_buffer.flag)
734     {
735       warnings++;
736       if (warning_buffer.message != NULL)
737         fputs (warning_buffer.message, stderr);
738       warning_buffer.flag = 0;
739     }
740 }
741
742
743 /* Issue an error.  */
744
745 void
746 gfc_error (const char *nocmsgid, ...)
747 {
748   va_list argp;
749
750   if (gfc_suppress_error)
751     return;
752
753   error_buffer.flag = 1;
754   error_buffer.index = 0;
755   cur_error_buffer = &error_buffer;
756
757   va_start (argp, nocmsgid);
758   error_print (_("Error:"), _(nocmsgid), argp);
759   va_end (argp);
760
761   error_char ('\0');
762
763   if (buffer_flag == 0)
764     gfc_increment_error_count();
765 }
766
767
768 /* Immediate error.  */
769
770 void
771 gfc_error_now (const char *nocmsgid, ...)
772 {
773   va_list argp;
774   int i;
775
776   error_buffer.flag = 1;
777   error_buffer.index = 0;
778   cur_error_buffer = &error_buffer;
779
780   i = buffer_flag;
781   buffer_flag = 0;
782
783   va_start (argp, nocmsgid);
784   error_print (_("Error:"), _(nocmsgid), argp);
785   va_end (argp);
786
787   error_char ('\0');
788
789   gfc_increment_error_count();
790
791   buffer_flag = i;
792
793   if (flag_fatal_errors)
794     exit (1);
795 }
796
797
798 /* Fatal error, never returns.  */
799
800 void
801 gfc_fatal_error (const char *nocmsgid, ...)
802 {
803   va_list argp;
804
805   buffer_flag = 0;
806
807   va_start (argp, nocmsgid);
808   error_print (_("Fatal Error:"), _(nocmsgid), argp);
809   va_end (argp);
810
811   exit (3);
812 }
813
814
815 /* This shouldn't happen... but sometimes does.  */
816
817 void
818 gfc_internal_error (const char *format, ...)
819 {
820   va_list argp;
821
822   buffer_flag = 0;
823
824   va_start (argp, format);
825
826   show_loci (&gfc_current_locus, NULL);
827   error_printf ("Internal Error at (1):");
828
829   error_print ("", format, argp);
830   va_end (argp);
831
832   exit (ICE_EXIT_CODE);
833 }
834
835
836 /* Clear the error flag when we start to compile a source line.  */
837
838 void
839 gfc_clear_error (void)
840 {
841   error_buffer.flag = 0;
842 }
843
844
845 /* Tests the state of error_flag.  */
846
847 int
848 gfc_error_flag_test (void)
849 {
850   return error_buffer.flag;
851 }
852
853
854 /* Check to see if any errors have been saved.
855    If so, print the error.  Returns the state of error_flag.  */
856
857 int
858 gfc_error_check (void)
859 {
860   int rc;
861
862   rc = error_buffer.flag;
863
864   if (error_buffer.flag)
865     {
866       if (error_buffer.message != NULL)
867         fputs (error_buffer.message, stderr);
868       error_buffer.flag = 0;
869
870       gfc_increment_error_count();
871
872       if (flag_fatal_errors)
873         exit (1);
874     }
875
876   return rc;
877 }
878
879
880 /* Save the existing error state.  */
881
882 void
883 gfc_push_error (gfc_error_buf *err)
884 {
885   err->flag = error_buffer.flag;
886   if (error_buffer.flag)
887     err->message = xstrdup (error_buffer.message);
888
889   error_buffer.flag = 0;
890 }
891
892
893 /* Restore a previous pushed error state.  */
894
895 void
896 gfc_pop_error (gfc_error_buf *err)
897 {
898   error_buffer.flag = err->flag;
899   if (error_buffer.flag)
900     {
901       size_t len = strlen (err->message) + 1;
902       gcc_assert (len <= error_buffer.allocated);
903       memcpy (error_buffer.message, err->message, len);
904       gfc_free (err->message);
905     }
906 }
907
908
909 /* Free a pushed error state, but keep the current error state.  */
910
911 void
912 gfc_free_error (gfc_error_buf *err)
913 {
914   if (err->flag)
915     gfc_free (err->message);
916 }
917
918
919 /* Debug wrapper for printf.  */
920
921 void
922 gfc_status (const char *cmsgid, ...)
923 {
924   va_list argp;
925
926   va_start (argp, cmsgid);
927
928   vprintf (_(cmsgid), argp);
929
930   va_end (argp);
931 }
932
933
934 /* Subroutine for outputting a single char so that we don't have to go
935    around creating a lot of 1-character strings.  */
936
937 void
938 gfc_status_char (char c)
939 {
940   putchar (c);
941 }
942
943
944 /* Report the number of warnings and errors that occurred to the caller.  */
945
946 void
947 gfc_get_errors (int *w, int *e)
948 {
949   if (w != NULL)
950     *w = warnings;
951   if (e != NULL)
952     *e = errors;
953 }