1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1991-2003 Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
27 with Err_Vars; use Err_Vars;
28 with Erroutc; use Erroutc;
29 with Namet; use Namet;
31 with Output; use Output;
32 with Scans; use Scans;
33 with Sinput; use Sinput;
35 package body Errutil is
37 Errors_Must_Be_Ignored : Boolean := False;
38 -- Set to True by procedure Set_Ignore_Errors (True), when calls to
39 -- error message procedures should be ignored (when parsing irrelevant
40 -- text in sources being preprocessed).
42 -----------------------
43 -- Local Subprograms --
44 -----------------------
46 procedure Error_Msg_AP (Msg : String);
47 -- Output a message just after the previous token.
49 procedure Output_Source_Line
50 (L : Physical_Line_Number;
51 Sfile : Source_File_Index;
53 Source_Type : String);
54 -- Outputs text of source line L, in file S, together with preceding line
55 -- number, as described above for Output_Line_Number. The Errs parameter
56 -- indicates if there are errors attached to the line, which forces
57 -- listing on, even in the presence of pragma List (Off).
59 procedure Set_Msg_Insertion_Column;
60 -- Handle column number insertion (@ insertion character)
62 procedure Set_Msg_Text (Text : String; Flag : Source_Ptr);
63 -- Add a sequence of characters to the current message. The characters may
64 -- be one of the special insertion characters (see documentation in spec).
65 -- Flag is the location at which the error is to be posted, which is used
66 -- to determine whether or not the # insertion needs a file name. The
67 -- variables Msg_Buffer, Msglen, Is_Style_Msg, Is_Warning_Msg, and
68 -- Is_Unconditional_Msg are set on return.
74 procedure Error_Msg_AP (Msg : String) is
79 -- If we had saved the Scan_Ptr value after scanning the previous
80 -- token, then we would have exactly the right place for putting
81 -- the flag immediately at hand. However, that would add at least
82 -- two instructions to a Scan call *just* to service the possibility
83 -- of an Error_Msg_AP call. So instead we reconstruct that value.
85 -- We have two possibilities, start with Prev_Token_Ptr and skip over
86 -- the current token, which is made harder by the possibility that this
87 -- token may be in error, or start with Token_Ptr and work backwards.
88 -- We used to take the second approach, but it's hard because of
89 -- comments, and harder still because things that look like comments
90 -- can appear inside strings. So now we take the first approach.
92 -- Note: in the case where there is no previous token, Prev_Token_Ptr
93 -- is set to Source_First, which is a reasonable position for the
94 -- error flag in this situation.
99 -- If the previous token is a string literal, we need a special approach
100 -- since there may be white space inside the literal and we don't want
101 -- to stop on that white space.
103 if Prev_Token = Tok_String_Literal then
107 if Source (S1) = C then
109 exit when Source (S1) /= C;
110 elsif Source (S1) in Line_Terminator then
115 -- Character literal also needs special handling
117 elsif Prev_Token = Tok_Char_Literal then
120 -- Otherwise we search forward for the end of the current token, marked
121 -- by a line terminator, white space, a comment symbol or if we bump
122 -- into the following token (i.e. the current token)
125 while Source (S1) not in Line_Terminator
126 and then Source (S1) /= ' '
127 and then Source (S1) /= ASCII.HT
128 and then (Source (S1) /= '-' or else Source (S1 + 1) /= '-')
129 and then S1 /= Token_Ptr
135 -- S1 is now set to the location for the flag
145 procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr) is
147 Next_Msg : Error_Msg_Id;
148 -- Pointer to next message at insertion point
150 Prev_Msg : Error_Msg_Id;
151 -- Pointer to previous message at insertion point
153 Sptr : Source_Ptr renames Flag_Location;
154 -- Corresponds to the Sptr value in the error message object
156 Optr : Source_Ptr renames Flag_Location;
157 -- Corresponds to the Optr value in the error message object. Note
158 -- that for this usage, Sptr and Optr always have the same value,
159 -- since we do not have to worry about generic instantiations.
162 if Errors_Must_Be_Ignored then
166 if Raise_Exception_On_Error /= 0 then
167 raise Error_Msg_Exception;
170 Test_Style_Warning_Serious_Msg (Msg);
171 Set_Msg_Text (Msg, Sptr);
173 -- Kill continuation if parent message killed
175 if Continuation and Last_Killed then
179 -- Return without doing anything if message is killed and this
180 -- is not the first error message. The philosophy is that if we
181 -- get a weird error message and we already have had a message,
182 -- then we hope the weird message is a junk cascaded message
184 -- Immediate return if warning message and warnings are suppressed
185 -- Note that style messages are not warnings for this purpose.
187 if Is_Warning_Msg and then Warnings_Suppressed (Sptr) then
188 Cur_Msg := No_Error_Msg;
192 -- Otherwise build error message object for new message
194 Errors.Increment_Last;
195 Cur_Msg := Errors.Last;
196 Errors.Table (Cur_Msg).Text := new String'(Msg_Buffer (1 .. Msglen));
197 Errors.Table (Cur_Msg).Next := No_Error_Msg;
198 Errors.Table (Cur_Msg).Sptr := Sptr;
199 Errors.Table (Cur_Msg).Optr := Optr;
200 Errors.Table (Cur_Msg).Sfile := Get_Source_File_Index (Sptr);
201 Errors.Table (Cur_Msg).Line := Get_Physical_Line_Number (Sptr);
202 Errors.Table (Cur_Msg).Col := Get_Column_Number (Sptr);
203 Errors.Table (Cur_Msg).Style := Is_Style_Msg;
204 Errors.Table (Cur_Msg).Warn := Is_Warning_Msg;
205 Errors.Table (Cur_Msg).Serious := Is_Serious_Error;
206 Errors.Table (Cur_Msg).Uncond := Is_Unconditional_Msg;
207 Errors.Table (Cur_Msg).Msg_Cont := Continuation;
208 Errors.Table (Cur_Msg).Deleted := False;
210 Prev_Msg := No_Error_Msg;
211 Next_Msg := First_Error_Msg;
213 while Next_Msg /= No_Error_Msg loop
215 Errors.Table (Cur_Msg).Sfile < Errors.Table (Next_Msg).Sfile;
217 if Errors.Table (Cur_Msg).Sfile = Errors.Table (Next_Msg).Sfile then
218 exit when Sptr < Errors.Table (Next_Msg).Sptr;
221 Prev_Msg := Next_Msg;
222 Next_Msg := Errors.Table (Next_Msg).Next;
225 -- Now we insert the new message in the error chain. The insertion
226 -- point for the message is after Prev_Msg and before Next_Msg.
228 -- The possible insertion point for the new message is after Prev_Msg
229 -- and before Next_Msg. However, this is where we do a special check
230 -- for redundant parsing messages, defined as messages posted on the
231 -- same line. The idea here is that probably such messages are junk
232 -- from the parser recovering. In full errors mode, we don't do this
233 -- deletion, but otherwise such messages are discarded at this stage.
235 if Prev_Msg /= No_Error_Msg
236 and then Errors.Table (Prev_Msg).Line =
237 Errors.Table (Cur_Msg).Line
238 and then Errors.Table (Prev_Msg).Sfile =
239 Errors.Table (Cur_Msg).Sfile
241 -- Don't delete unconditional messages and at this stage,
242 -- don't delete continuation lines (we attempted to delete
243 -- those earlier if the parent message was deleted.
245 if not Errors.Table (Cur_Msg).Uncond
246 and then not Continuation
249 -- Don't delete if prev msg is warning and new msg is
250 -- an error. This is because we don't want a real error
251 -- masked by a warning. In all other cases (that is parse
252 -- errors for the same line that are not unconditional)
253 -- we do delete the message. This helps to avoid
254 -- junk extra messages from cascaded parsing errors
256 if not (Errors.Table (Prev_Msg).Warn
258 Errors.Table (Prev_Msg).Style)
260 (Errors.Table (Cur_Msg).Warn
262 Errors.Table (Cur_Msg).Style)
264 -- All tests passed, delete the message by simply
265 -- returning without any further processing.
267 if not Continuation then
276 -- Come here if message is to be inserted in the error chain
278 if not Continuation then
279 Last_Killed := False;
282 if Prev_Msg = No_Error_Msg then
283 First_Error_Msg := Cur_Msg;
285 Errors.Table (Prev_Msg).Next := Cur_Msg;
288 Errors.Table (Cur_Msg).Next := Next_Msg;
290 -- Bump appropriate statistics count
292 if Errors.Table (Cur_Msg).Warn or Errors.Table (Cur_Msg).Style then
293 Warnings_Detected := Warnings_Detected + 1;
295 Total_Errors_Detected := Total_Errors_Detected + 1;
297 if Errors.Table (Cur_Msg).Serious then
298 Serious_Errors_Detected := Serious_Errors_Detected + 1;
308 procedure Error_Msg_S (Msg : String) is
310 Error_Msg (Msg, Scan_Ptr);
317 procedure Error_Msg_SC (Msg : String) is
319 -- If we are at end of file, post the flag after the previous token
321 if Token = Tok_EOF then
324 -- For all other cases the message is posted at the current token
328 Error_Msg (Msg, Token_Ptr);
336 procedure Error_Msg_SP (Msg : String) is
338 -- Note: in the case where there is no previous token, Prev_Token_Ptr
339 -- is set to Source_First, which is a reasonable position for the
340 -- error flag in this situation
342 Error_Msg (Msg, Prev_Token_Ptr);
349 procedure Finalize (Source_Type : String := "project") is
356 -- Eliminate any duplicated error messages from the list. This is
357 -- done after the fact to avoid problems with Change_Error_Text.
359 Cur := First_Error_Msg;
360 while Cur /= No_Error_Msg loop
361 Nxt := Errors.Table (Cur).Next;
364 while F /= No_Error_Msg
365 and then Errors.Table (F).Sptr = Errors.Table (Cur).Sptr
367 Check_Duplicate_Message (Cur, F);
368 F := Errors.Table (F).Next;
376 if Brief_Output or (not Full_List and not Verbose_Mode) then
377 E := First_Error_Msg;
380 while E /= No_Error_Msg loop
381 if not Errors.Table (E).Deleted then
382 if Full_Path_Name_For_Brief_Errors then
383 Write_Name (Full_Ref_Name (Errors.Table (E).Sfile));
385 Write_Name (Reference_Name (Errors.Table (E).Sfile));
389 Write_Int (Int (Physical_To_Logical
390 (Errors.Table (E).Line,
391 Errors.Table (E).Sfile)));
394 if Errors.Table (E).Col < 10 then
398 Write_Int (Int (Errors.Table (E).Col));
404 E := Errors.Table (E).Next;
410 -- Full source listing case
413 List_Pragmas_Index := 1;
414 List_Pragmas_Mode := True;
415 E := First_Error_Msg;
418 -- First list initial main source file with its error messages
420 for N in 1 .. Last_Source_Line (Main_Source_File) loop
423 and then Errors.Table (E).Line = N
424 and then Errors.Table (E).Sfile = Main_Source_File;
426 Output_Source_Line (N, Main_Source_File, Err_Flag, Source_Type);
429 Output_Error_Msgs (E);
436 -- Then output errors, if any, for subsidiary units
438 while E /= No_Error_Msg
439 and then Errors.Table (E).Sfile /= Main_Source_File
443 (Errors.Table (E).Line,
444 Errors.Table (E).Sfile,
447 Output_Error_Msgs (E);
451 -- Verbose mode (error lines only with error flags)
454 E := First_Error_Msg;
456 -- Loop through error lines
458 while E /= No_Error_Msg loop
461 (Errors.Table (E).Line,
462 Errors.Table (E).Sfile,
465 Output_Error_Msgs (E);
469 -- Output error summary if verbose or full list mode
471 if Verbose_Mode or else Full_List then
473 -- Extra blank line if error messages or source listing were output
475 if Total_Errors_Detected + Warnings_Detected > 0
481 -- Message giving number of lines read and number of errors detected.
482 -- This normally goes to Standard_Output. The exception is when brief
483 -- mode is not set, verbose mode (or full list mode) is set, and
484 -- there are errors. In this case we send the message to standard
485 -- error to make sure that *something* appears on standard error in
486 -- an error situation.
488 -- Formerly, only the "# errors" suffix was sent to stderr, whereas
489 -- "# lines:" appeared on stdout. This caused problems on VMS when
490 -- the stdout buffer was flushed, giving an extra line feed after
493 if Total_Errors_Detected + Warnings_Detected /= 0
494 and then not Brief_Output
495 and then (Verbose_Mode or Full_List)
500 -- Message giving total number of lines
503 Write_Int (Num_Source_Lines (Main_Source_File));
505 if Num_Source_Lines (Main_Source_File) = 1 then
506 Write_Str (" line: ");
508 Write_Str (" lines: ");
511 if Total_Errors_Detected = 0 then
512 Write_Str ("No errors");
514 elsif Total_Errors_Detected = 1 then
515 Write_Str ("1 error");
518 Write_Int (Total_Errors_Detected);
519 Write_Str (" errors");
522 if Warnings_Detected /= 0 then
524 Write_Int (Warnings_Detected);
525 Write_Str (" warning");
527 if Warnings_Detected /= 1 then
531 if Warning_Mode = Treat_As_Error then
532 Write_Str (" (treated as error");
534 if Warnings_Detected /= 1 then
546 if Maximum_Errors /= 0
547 and then Total_Errors_Detected + Warnings_Detected = Maximum_Errors
550 Write_Str ("fatal error: maximum errors reached");
555 if Warning_Mode = Treat_As_Error then
556 Total_Errors_Detected := Total_Errors_Detected + Warnings_Detected;
557 Warnings_Detected := 0;
566 procedure Initialize is
569 First_Error_Msg := No_Error_Msg;
570 Last_Error_Msg := No_Error_Msg;
571 Serious_Errors_Detected := 0;
572 Total_Errors_Detected := 0;
573 Warnings_Detected := 0;
574 Cur_Msg := No_Error_Msg;
576 -- Initialize warnings table, if all warnings are suppressed, supply
577 -- an initial dummy entry covering all possible source locations.
583 ------------------------
584 -- Output_Source_Line --
585 ------------------------
587 procedure Output_Source_Line
588 (L : Physical_Line_Number;
589 Sfile : Source_File_Index;
591 Source_Type : String)
596 Line_Number_Output : Boolean := False;
597 -- Set True once line number is output
600 if Sfile /= Current_Error_Source_File then
601 Write_Str ("==============Error messages for ");
602 Write_Str (Source_Type);
603 Write_Str (" file: ");
604 Write_Name (Full_File_Name (Sfile));
606 Current_Error_Source_File := Sfile;
610 Output_Line_Number (Physical_To_Logical (L, Sfile));
611 Line_Number_Output := True;
614 S := Line_Start (L, Sfile);
617 C := Source_Text (Sfile) (S);
618 exit when C = ASCII.LF or else C = ASCII.CR or else C = EOF;
627 if Line_Number_Output then
630 end Output_Source_Line;
632 -----------------------
633 -- Set_Ignore_Errors --
634 -----------------------
636 procedure Set_Ignore_Errors (To : Boolean) is
638 Errors_Must_Be_Ignored := To;
639 end Set_Ignore_Errors;
641 ------------------------------
642 -- Set_Msg_Insertion_Column --
643 ------------------------------
645 procedure Set_Msg_Insertion_Column is
647 if Style.RM_Column_Check then
648 Set_Msg_Str (" in column ");
649 Set_Msg_Int (Int (Error_Msg_Col) + 1);
651 end Set_Msg_Insertion_Column;
657 procedure Set_Msg_Text (Text : String; Flag : Source_Ptr) is
658 C : Character; -- Current character
659 P : Natural; -- Current index;
662 Manual_Quote_Mode := False;
664 Flag_Source := Get_Source_File_Index (Flag);
667 while P <= Text'Last loop
671 -- Check for insertion character
674 Set_Msg_Insertion_Name;
682 Set_Msg_Insertion_File_Name;
690 Set_Msg_Insertion_Reserved_Name;
698 Set_Msg_Insertion_Line_Number (Error_Msg_Sloc, Flag);
701 Continuation := True;
704 Set_Msg_Insertion_Column;
707 Set_Msg_Insertion_Uint;
710 Manual_Quote_Mode := not Manual_Quote_Mode;
714 Is_Unconditional_Msg := True;
723 Set_Msg_Char (Text (P));
726 -- Upper case letter (start of reserved word if 2 or more)
728 elsif C in 'A' .. 'Z'
729 and then P <= Text'Last
730 and then Text (P) in 'A' .. 'Z'
733 Set_Msg_Insertion_Reserved_Word (Text, P);
735 -- Normal character with no special treatment