|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT COMPILER COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- E R R U T I L --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
131
|
9 -- Copyright (C) 1991-2018, Free Software Foundation, Inc. --
|
|
111
|
10 -- --
|
|
|
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 3, 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 COPYING3. If not, go to --
|
|
|
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
|
|
|
20 -- --
|
|
|
21 -- GNAT was originally developed by the GNAT team at New York University. --
|
|
|
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
|
23 -- --
|
|
|
24 ------------------------------------------------------------------------------
|
|
|
25
|
|
|
26 with Atree; use Atree;
|
|
|
27 with Err_Vars; use Err_Vars;
|
|
|
28 with Erroutc; use Erroutc;
|
|
|
29 with Namet; use Namet;
|
|
|
30 with Opt; use Opt;
|
|
|
31 with Output; use Output;
|
|
|
32 with Scans; use Scans;
|
|
|
33 with Sinput; use Sinput;
|
|
|
34 with Stringt; use Stringt;
|
|
|
35 with Stylesw; use Stylesw;
|
|
|
36
|
|
|
37 package body Errutil is
|
|
|
38
|
|
|
39 Errors_Must_Be_Ignored : Boolean := False;
|
|
|
40 -- Set to True by procedure Set_Ignore_Errors (True), when calls to
|
|
|
41 -- error message procedures should be ignored (when parsing irrelevant
|
|
|
42 -- text in sources being preprocessed).
|
|
|
43
|
|
|
44 -----------------------
|
|
|
45 -- Local Subprograms --
|
|
|
46 -----------------------
|
|
|
47
|
|
|
48 procedure Error_Msg_AP (Msg : String);
|
|
|
49 -- Output a message just after the previous token
|
|
|
50
|
|
|
51 procedure Output_Source_Line
|
|
|
52 (L : Physical_Line_Number;
|
|
|
53 Sfile : Source_File_Index;
|
|
|
54 Errs : Boolean;
|
|
|
55 Source_Type : String);
|
|
|
56 -- Outputs text of source line L, in file S, together with preceding line
|
|
|
57 -- number, as described above for Output_Line_Number. The Errs parameter
|
|
|
58 -- indicates if there are errors attached to the line, which forces
|
|
|
59 -- listing on, even in the presence of pragma List (Off).
|
|
|
60
|
|
|
61 procedure Set_Msg_Insertion_Column;
|
|
|
62 -- Handle column number insertion (@ insertion character)
|
|
|
63
|
|
|
64 procedure Set_Msg_Text (Text : String; Flag : Source_Ptr);
|
|
|
65 -- Add a sequence of characters to the current message. The characters may
|
|
|
66 -- be one of the special insertion characters (see documentation in spec).
|
|
|
67 -- Flag is the location at which the error is to be posted, which is used
|
|
|
68 -- to determine whether or not the # insertion needs a file name. The
|
|
|
69 -- variables Msg_Buffer, Msglen, Is_Style_Msg, Is_Warning_Msg, and
|
|
|
70 -- Is_Unconditional_Msg are set on return.
|
|
|
71
|
|
|
72 ------------------
|
|
|
73 -- Error_Msg_AP --
|
|
|
74 ------------------
|
|
|
75
|
|
|
76 procedure Error_Msg_AP (Msg : String) is
|
|
|
77 S1 : Source_Ptr;
|
|
|
78 C : Character;
|
|
|
79
|
|
|
80 begin
|
|
|
81 -- If we had saved the Scan_Ptr value after scanning the previous
|
|
|
82 -- token, then we would have exactly the right place for putting
|
|
|
83 -- the flag immediately at hand. However, that would add at least
|
|
|
84 -- two instructions to a Scan call *just* to service the possibility
|
|
|
85 -- of an Error_Msg_AP call. So instead we reconstruct that value.
|
|
|
86
|
|
|
87 -- We have two possibilities, start with Prev_Token_Ptr and skip over
|
|
|
88 -- the current token, which is made harder by the possibility that this
|
|
|
89 -- token may be in error, or start with Token_Ptr and work backwards.
|
|
|
90 -- We used to take the second approach, but it's hard because of
|
|
|
91 -- comments, and harder still because things that look like comments
|
|
|
92 -- can appear inside strings. So now we take the first approach.
|
|
|
93
|
|
|
94 -- Note: in the case where there is no previous token, Prev_Token_Ptr
|
|
|
95 -- is set to Source_First, which is a reasonable position for the
|
|
|
96 -- error flag in this situation.
|
|
|
97
|
|
|
98 S1 := Prev_Token_Ptr;
|
|
|
99 C := Source (S1);
|
|
|
100
|
|
|
101 -- If the previous token is a string literal, we need a special approach
|
|
|
102 -- since there may be white space inside the literal and we don't want
|
|
|
103 -- to stop on that white space.
|
|
|
104
|
|
|
105 -- Note that it is not worth worrying about special UTF_32 line
|
|
|
106 -- terminator characters in this context, since this is only about
|
|
|
107 -- error recovery anyway.
|
|
|
108
|
|
|
109 if Prev_Token = Tok_String_Literal then
|
|
|
110 loop
|
|
|
111 S1 := S1 + 1;
|
|
|
112
|
|
|
113 if Source (S1) = C then
|
|
|
114 S1 := S1 + 1;
|
|
|
115 exit when Source (S1) /= C;
|
|
|
116 elsif Source (S1) in Line_Terminator then
|
|
|
117 exit;
|
|
|
118 end if;
|
|
|
119 end loop;
|
|
|
120
|
|
|
121 -- Character literal also needs special handling
|
|
|
122
|
|
|
123 elsif Prev_Token = Tok_Char_Literal then
|
|
|
124 S1 := S1 + 3;
|
|
|
125
|
|
|
126 -- Otherwise we search forward for the end of the current token, marked
|
|
|
127 -- by a line terminator, white space, a comment symbol or if we bump
|
|
|
128 -- into the following token (i.e. the current token)
|
|
|
129
|
|
|
130 -- Note that it is not worth worrying about special UTF_32 line
|
|
|
131 -- terminator characters in this context, since this is only about
|
|
|
132 -- error recovery anyway.
|
|
|
133
|
|
|
134 else
|
|
|
135 while Source (S1) not in Line_Terminator
|
|
|
136 and then Source (S1) /= ' '
|
|
|
137 and then Source (S1) /= ASCII.HT
|
|
|
138 and then (Source (S1) /= '-' or else Source (S1 + 1) /= '-')
|
|
|
139 and then S1 /= Token_Ptr
|
|
|
140 loop
|
|
|
141 S1 := S1 + 1;
|
|
|
142 end loop;
|
|
|
143 end if;
|
|
|
144
|
|
|
145 -- S1 is now set to the location for the flag
|
|
|
146
|
|
|
147 Error_Msg (Msg, S1);
|
|
|
148
|
|
|
149 end Error_Msg_AP;
|
|
|
150
|
|
|
151 ---------------
|
|
|
152 -- Error_Msg --
|
|
|
153 ---------------
|
|
|
154
|
|
|
155 procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr) is
|
|
|
156
|
|
|
157 Next_Msg : Error_Msg_Id;
|
|
|
158 -- Pointer to next message at insertion point
|
|
|
159
|
|
|
160 Prev_Msg : Error_Msg_Id;
|
|
|
161 -- Pointer to previous message at insertion point
|
|
|
162
|
|
|
163 Sptr : Source_Ptr renames Flag_Location;
|
|
|
164 -- Corresponds to the Sptr value in the error message object
|
|
|
165
|
|
|
166 Optr : Source_Ptr renames Flag_Location;
|
|
|
167 -- Corresponds to the Optr value in the error message object. Note that
|
|
|
168 -- for this usage, Sptr and Optr always have the same value, since we do
|
|
|
169 -- not have to worry about generic instantiations.
|
|
|
170
|
|
|
171 begin
|
|
|
172 if Errors_Must_Be_Ignored then
|
|
|
173 return;
|
|
|
174 end if;
|
|
|
175
|
|
|
176 if Raise_Exception_On_Error /= 0 then
|
|
|
177 raise Error_Msg_Exception;
|
|
|
178 end if;
|
|
|
179
|
|
|
180 Prescan_Message (Msg);
|
|
|
181 Set_Msg_Text (Msg, Sptr);
|
|
|
182
|
|
|
183 -- Kill continuation if parent message killed
|
|
|
184
|
|
|
185 if Continuation and Last_Killed then
|
|
|
186 return;
|
|
|
187 end if;
|
|
|
188
|
|
|
189 -- Return without doing anything if message is killed and this is not
|
|
|
190 -- the first error message. The philosophy is that if we get a weird
|
|
|
191 -- error message and we already have had a message, then we hope the
|
|
|
192 -- weird message is a junk cascaded message
|
|
|
193
|
|
|
194 -- Immediate return if warning message and warnings are suppressed.
|
|
|
195 -- Note that style messages are not warnings for this purpose.
|
|
|
196
|
|
|
197 if Is_Warning_Msg and then Warnings_Suppressed (Sptr) /= No_String then
|
|
|
198 Cur_Msg := No_Error_Msg;
|
|
|
199 return;
|
|
|
200 end if;
|
|
|
201
|
|
|
202 -- Otherwise build error message object for new message
|
|
|
203
|
|
|
204 Errors.Append
|
|
|
205 (New_Val =>
|
|
|
206 (Text => new String'(Msg_Buffer (1 .. Msglen)),
|
|
|
207 Next => No_Error_Msg,
|
|
|
208 Prev => No_Error_Msg,
|
|
|
209 Sfile => Get_Source_File_Index (Sptr),
|
|
|
210 Sptr => Sptr,
|
|
|
211 Optr => Optr,
|
|
|
212 Line => Get_Physical_Line_Number (Sptr),
|
|
|
213 Col => Get_Column_Number (Sptr),
|
|
|
214 Warn => Is_Warning_Msg,
|
|
|
215 Info => Is_Info_Msg,
|
|
|
216 Check => Is_Check_Msg,
|
|
|
217 Warn_Err => Warning_Mode = Treat_As_Error,
|
|
|
218 Warn_Chr => Warning_Msg_Char,
|
|
|
219 Style => Is_Style_Msg,
|
|
|
220 Serious => Is_Serious_Error,
|
|
|
221 Uncond => Is_Unconditional_Msg,
|
|
|
222 Msg_Cont => Continuation,
|
|
|
223 Deleted => False,
|
|
|
224 Node => Empty));
|
|
|
225
|
|
|
226 Cur_Msg := Errors.Last;
|
|
|
227 Prev_Msg := No_Error_Msg;
|
|
|
228 Next_Msg := First_Error_Msg;
|
|
|
229
|
|
|
230 while Next_Msg /= No_Error_Msg loop
|
|
|
231 exit when
|
|
|
232 Errors.Table (Cur_Msg).Sfile < Errors.Table (Next_Msg).Sfile;
|
|
|
233
|
|
|
234 if Errors.Table (Cur_Msg).Sfile = Errors.Table (Next_Msg).Sfile then
|
|
|
235 exit when Sptr < Errors.Table (Next_Msg).Sptr;
|
|
|
236 end if;
|
|
|
237
|
|
|
238 Prev_Msg := Next_Msg;
|
|
|
239 Next_Msg := Errors.Table (Next_Msg).Next;
|
|
|
240 end loop;
|
|
|
241
|
|
|
242 -- Now we insert the new message in the error chain. The insertion
|
|
|
243 -- point for the message is after Prev_Msg and before Next_Msg.
|
|
|
244
|
|
|
245 -- The possible insertion point for the new message is after Prev_Msg
|
|
|
246 -- and before Next_Msg. However, this is where we do a special check
|
|
|
247 -- for redundant parsing messages, defined as messages posted on the
|
|
|
248 -- same line. The idea here is that probably such messages are junk
|
|
|
249 -- from the parser recovering. In full errors mode, we don't do this
|
|
|
250 -- deletion, but otherwise such messages are discarded at this stage.
|
|
|
251
|
|
|
252 if Prev_Msg /= No_Error_Msg
|
|
|
253 and then Errors.Table (Prev_Msg).Line =
|
|
|
254 Errors.Table (Cur_Msg).Line
|
|
|
255 and then Errors.Table (Prev_Msg).Sfile =
|
|
|
256 Errors.Table (Cur_Msg).Sfile
|
|
|
257 then
|
|
|
258 -- Don't delete unconditional messages and at this stage, don't
|
|
|
259 -- delete continuation lines (we attempted to delete those earlier
|
|
|
260 -- if the parent message was deleted.
|
|
|
261
|
|
|
262 if not Errors.Table (Cur_Msg).Uncond
|
|
|
263 and then not Continuation
|
|
|
264 then
|
|
|
265
|
|
|
266 -- Don't delete if prev msg is warning and new msg is an error.
|
|
|
267 -- This is because we don't want a real error masked by a warning.
|
|
|
268 -- In all other cases (that is parse errors for the same line that
|
|
|
269 -- are not unconditional) we do delete the message. This helps to
|
|
|
270 -- avoid junk extra messages from cascaded parsing errors
|
|
|
271
|
|
|
272 if not (Errors.Table (Prev_Msg).Warn
|
|
|
273 or else
|
|
|
274 Errors.Table (Prev_Msg).Style)
|
|
|
275 or else
|
|
|
276 (Errors.Table (Cur_Msg).Warn
|
|
|
277 or else
|
|
|
278 Errors.Table (Cur_Msg).Style)
|
|
|
279 then
|
|
|
280 -- All tests passed, delete the message by simply returning
|
|
|
281 -- without any further processing.
|
|
|
282
|
|
|
283 if not Continuation then
|
|
|
284 Last_Killed := True;
|
|
|
285 end if;
|
|
|
286
|
|
|
287 return;
|
|
|
288 end if;
|
|
|
289 end if;
|
|
|
290 end if;
|
|
|
291
|
|
|
292 -- Come here if message is to be inserted in the error chain
|
|
|
293
|
|
|
294 if not Continuation then
|
|
|
295 Last_Killed := False;
|
|
|
296 end if;
|
|
|
297
|
|
|
298 if Prev_Msg = No_Error_Msg then
|
|
|
299 First_Error_Msg := Cur_Msg;
|
|
|
300 else
|
|
|
301 Errors.Table (Prev_Msg).Next := Cur_Msg;
|
|
|
302 end if;
|
|
|
303
|
|
|
304 Errors.Table (Cur_Msg).Next := Next_Msg;
|
|
|
305
|
|
|
306 -- Bump appropriate statistics counts
|
|
|
307
|
|
|
308 if Errors.Table (Cur_Msg).Info then
|
|
|
309
|
|
|
310 -- Could be (usually is) both "info" and "warning"
|
|
|
311
|
|
|
312 if Errors.Table (Cur_Msg).Warn then
|
|
|
313 Warning_Info_Messages := Warning_Info_Messages + 1;
|
|
|
314 Warnings_Detected := Warnings_Detected + 1;
|
|
|
315 else
|
|
|
316 Report_Info_Messages := Report_Info_Messages + 1;
|
|
|
317 end if;
|
|
|
318
|
|
|
319 elsif Errors.Table (Cur_Msg).Warn
|
|
|
320 or else Errors.Table (Cur_Msg).Style
|
|
|
321 then
|
|
|
322 Warnings_Detected := Warnings_Detected + 1;
|
|
|
323
|
|
|
324 elsif Errors.Table (Cur_Msg).Check then
|
|
|
325 Check_Messages := Check_Messages + 1;
|
|
|
326
|
|
|
327 else
|
|
|
328 Total_Errors_Detected := Total_Errors_Detected + 1;
|
|
|
329
|
|
|
330 if Errors.Table (Cur_Msg).Serious then
|
|
|
331 Serious_Errors_Detected := Serious_Errors_Detected + 1;
|
|
|
332 end if;
|
|
|
333 end if;
|
|
|
334
|
|
|
335 end Error_Msg;
|
|
|
336
|
|
|
337 -----------------
|
|
|
338 -- Error_Msg_S --
|
|
|
339 -----------------
|
|
|
340
|
|
|
341 procedure Error_Msg_S (Msg : String) is
|
|
|
342 begin
|
|
|
343 Error_Msg (Msg, Scan_Ptr);
|
|
|
344 end Error_Msg_S;
|
|
|
345
|
|
|
346 ------------------
|
|
|
347 -- Error_Msg_SC --
|
|
|
348 ------------------
|
|
|
349
|
|
|
350 procedure Error_Msg_SC (Msg : String) is
|
|
|
351 begin
|
|
|
352 -- If we are at end of file, post the flag after the previous token
|
|
|
353
|
|
|
354 if Token = Tok_EOF then
|
|
|
355 Error_Msg_AP (Msg);
|
|
|
356
|
|
|
357 -- For all other cases the message is posted at the current token
|
|
|
358 -- pointer position
|
|
|
359
|
|
|
360 else
|
|
|
361 Error_Msg (Msg, Token_Ptr);
|
|
|
362 end if;
|
|
|
363 end Error_Msg_SC;
|
|
|
364
|
|
|
365 ------------------
|
|
|
366 -- Error_Msg_SP --
|
|
|
367 ------------------
|
|
|
368
|
|
|
369 procedure Error_Msg_SP (Msg : String) is
|
|
|
370 begin
|
|
|
371 -- Note: in the case where there is no previous token, Prev_Token_Ptr
|
|
|
372 -- is set to Source_First, which is a reasonable position for the
|
|
|
373 -- error flag in this situation
|
|
|
374
|
|
|
375 Error_Msg (Msg, Prev_Token_Ptr);
|
|
|
376 end Error_Msg_SP;
|
|
|
377
|
|
|
378 --------------
|
|
|
379 -- Finalize --
|
|
|
380 --------------
|
|
|
381
|
|
|
382 procedure Finalize (Source_Type : String := "project") is
|
|
|
383 Cur : Error_Msg_Id;
|
|
|
384 Nxt : Error_Msg_Id;
|
|
|
385 E, F : Error_Msg_Id;
|
|
|
386 Err_Flag : Boolean;
|
|
|
387
|
|
|
388 begin
|
|
|
389 -- Eliminate any duplicated error messages from the list. This is
|
|
|
390 -- done after the fact to avoid problems with Change_Error_Text.
|
|
|
391
|
|
|
392 Cur := First_Error_Msg;
|
|
|
393 while Cur /= No_Error_Msg loop
|
|
|
394 Nxt := Errors.Table (Cur).Next;
|
|
|
395
|
|
|
396 F := Nxt;
|
|
|
397 while F /= No_Error_Msg
|
|
|
398 and then Errors.Table (F).Sptr = Errors.Table (Cur).Sptr
|
|
|
399 loop
|
|
|
400 Check_Duplicate_Message (Cur, F);
|
|
|
401 F := Errors.Table (F).Next;
|
|
|
402 end loop;
|
|
|
403
|
|
|
404 Cur := Nxt;
|
|
|
405 end loop;
|
|
|
406
|
|
|
407 -- Brief Error mode
|
|
|
408
|
|
|
409 if Brief_Output or (not Full_List and not Verbose_Mode) then
|
|
|
410 E := First_Error_Msg;
|
|
|
411 Set_Standard_Error;
|
|
|
412
|
|
|
413 while E /= No_Error_Msg loop
|
|
|
414 if not Errors.Table (E).Deleted then
|
|
|
415 if Full_Path_Name_For_Brief_Errors then
|
|
|
416 Write_Name (Full_Ref_Name (Errors.Table (E).Sfile));
|
|
|
417 else
|
|
|
418 Write_Name (Reference_Name (Errors.Table (E).Sfile));
|
|
|
419 end if;
|
|
|
420
|
|
|
421 Write_Char (':');
|
|
|
422 Write_Int (Int (Physical_To_Logical
|
|
|
423 (Errors.Table (E).Line,
|
|
|
424 Errors.Table (E).Sfile)));
|
|
|
425 Write_Char (':');
|
|
|
426
|
|
|
427 if Errors.Table (E).Col < 10 then
|
|
|
428 Write_Char ('0');
|
|
|
429 end if;
|
|
|
430
|
|
|
431 Write_Int (Int (Errors.Table (E).Col));
|
|
|
432 Write_Str (": ");
|
|
|
433 Output_Msg_Text (E);
|
|
|
434 Write_Eol;
|
|
|
435 end if;
|
|
|
436
|
|
|
437 E := Errors.Table (E).Next;
|
|
|
438 end loop;
|
|
|
439
|
|
|
440 Set_Standard_Output;
|
|
|
441 end if;
|
|
|
442
|
|
|
443 -- Full source listing case
|
|
|
444
|
|
|
445 if Full_List then
|
|
|
446 List_Pragmas_Index := 1;
|
|
|
447 List_Pragmas_Mode := True;
|
|
|
448 E := First_Error_Msg;
|
|
|
449 Write_Eol;
|
|
|
450
|
|
|
451 -- First list initial main source file with its error messages
|
|
|
452
|
|
|
453 for N in 1 .. Last_Source_Line (Main_Source_File) loop
|
|
|
454 Err_Flag :=
|
|
|
455 E /= No_Error_Msg
|
|
|
456 and then Errors.Table (E).Line = N
|
|
|
457 and then Errors.Table (E).Sfile = Main_Source_File;
|
|
|
458
|
|
|
459 Output_Source_Line (N, Main_Source_File, Err_Flag, Source_Type);
|
|
|
460
|
|
|
461 if Err_Flag then
|
|
|
462 Output_Error_Msgs (E);
|
|
|
463
|
|
|
464 Write_Eol;
|
|
|
465 end if;
|
|
|
466 end loop;
|
|
|
467
|
|
|
468 -- Then output errors, if any, for subsidiary units
|
|
|
469
|
|
|
470 while E /= No_Error_Msg
|
|
|
471 and then Errors.Table (E).Sfile /= Main_Source_File
|
|
|
472 loop
|
|
|
473 Write_Eol;
|
|
|
474 Output_Source_Line
|
|
|
475 (Errors.Table (E).Line,
|
|
|
476 Errors.Table (E).Sfile,
|
|
|
477 True,
|
|
|
478 Source_Type);
|
|
|
479 Output_Error_Msgs (E);
|
|
|
480 end loop;
|
|
|
481 end if;
|
|
|
482
|
|
|
483 -- Verbose mode (error lines only with error flags)
|
|
|
484
|
|
|
485 if Verbose_Mode then
|
|
|
486 E := First_Error_Msg;
|
|
|
487
|
|
|
488 -- Loop through error lines
|
|
|
489
|
|
|
490 while E /= No_Error_Msg loop
|
|
|
491 Write_Eol;
|
|
|
492 Output_Source_Line
|
|
|
493 (Errors.Table (E).Line,
|
|
|
494 Errors.Table (E).Sfile,
|
|
|
495 True,
|
|
|
496 Source_Type);
|
|
|
497 Output_Error_Msgs (E);
|
|
|
498 end loop;
|
|
|
499 end if;
|
|
|
500
|
|
|
501 -- Output error summary if verbose or full list mode
|
|
|
502
|
|
|
503 if Verbose_Mode or else Full_List then
|
|
|
504
|
|
|
505 -- Extra blank line if error messages or source listing were output
|
|
|
506
|
|
|
507 if Total_Errors_Detected + Warnings_Detected > 0
|
|
|
508 or else Full_List
|
|
|
509 then
|
|
|
510 Write_Eol;
|
|
|
511 end if;
|
|
|
512
|
|
|
513 -- Message giving number of lines read and number of errors detected.
|
|
|
514 -- This normally goes to Standard_Output. The exception is when brief
|
|
|
515 -- mode is not set, verbose mode (or full list mode) is set, and
|
|
|
516 -- there are errors. In this case we send the message to standard
|
|
|
517 -- error to make sure that *something* appears on standard error in
|
|
|
518 -- an error situation.
|
|
|
519
|
|
|
520 -- Historical note: Formerly, only the "# errors" suffix was sent
|
|
|
521 -- to stderr, whereas "# lines:" appeared on stdout. This caused
|
|
|
522 -- some problems on now-obsolete ports, but there seems to be no
|
|
|
523 -- reason to revert this page since it would be incompatible.
|
|
|
524
|
|
|
525 if Total_Errors_Detected + Warnings_Detected /= 0
|
|
|
526 and then not Brief_Output
|
|
|
527 and then (Verbose_Mode or Full_List)
|
|
|
528 then
|
|
|
529 Set_Standard_Error;
|
|
|
530 end if;
|
|
|
531
|
|
|
532 -- Message giving total number of lines
|
|
|
533
|
|
|
534 Write_Str (" ");
|
|
|
535 Write_Int (Num_Source_Lines (Main_Source_File));
|
|
|
536
|
|
|
537 if Num_Source_Lines (Main_Source_File) = 1 then
|
|
|
538 Write_Str (" line: ");
|
|
|
539 else
|
|
|
540 Write_Str (" lines: ");
|
|
|
541 end if;
|
|
|
542
|
|
|
543 if Total_Errors_Detected = 0 then
|
|
|
544 Write_Str ("No errors");
|
|
|
545
|
|
|
546 elsif Total_Errors_Detected = 1 then
|
|
|
547 Write_Str ("1 error");
|
|
|
548
|
|
|
549 else
|
|
|
550 Write_Int (Total_Errors_Detected);
|
|
|
551 Write_Str (" errors");
|
|
|
552 end if;
|
|
|
553
|
|
|
554 if Warnings_Detected - Warning_Info_Messages /= 0 then
|
|
|
555 Write_Str (", ");
|
|
|
556 Write_Int (Warnings_Detected - Warning_Info_Messages);
|
|
|
557 Write_Str (" warning");
|
|
|
558
|
|
|
559 if Warnings_Detected - Warning_Info_Messages /= 1 then
|
|
|
560 Write_Char ('s');
|
|
|
561 end if;
|
|
|
562
|
|
|
563 if Warning_Mode = Treat_As_Error then
|
|
|
564 Write_Str (" (treated as error");
|
|
|
565
|
|
|
566 if Warnings_Detected - Warning_Info_Messages /= 1 then
|
|
|
567 Write_Char ('s');
|
|
|
568 end if;
|
|
|
569
|
|
|
570 Write_Char (')');
|
|
|
571 end if;
|
|
|
572 end if;
|
|
|
573
|
|
|
574 Write_Eol;
|
|
|
575 Set_Standard_Output;
|
|
|
576 end if;
|
|
|
577
|
|
|
578 if Maximum_Messages /= 0 then
|
|
|
579 if Warnings_Detected >= Maximum_Messages then
|
|
|
580 Set_Standard_Error;
|
|
|
581 Write_Line ("maximum number of warnings detected");
|
|
|
582 Warning_Mode := Suppress;
|
|
|
583 end if;
|
|
|
584
|
|
|
585 if Total_Errors_Detected >= Maximum_Messages then
|
|
|
586 Set_Standard_Error;
|
|
|
587 Write_Line ("fatal error: maximum errors reached");
|
|
|
588 Set_Standard_Output;
|
|
|
589 end if;
|
|
|
590 end if;
|
|
|
591
|
|
|
592 -- Even though Warning_Info_Messages are a subclass of warnings, they
|
|
|
593 -- must not be treated as errors when -gnatwe is in effect.
|
|
|
594
|
|
|
595 if Warning_Mode = Treat_As_Error then
|
|
|
596 Total_Errors_Detected :=
|
|
|
597 Total_Errors_Detected + Warnings_Detected - Warning_Info_Messages;
|
|
|
598 Warnings_Detected := Warning_Info_Messages;
|
|
|
599 end if;
|
|
|
600
|
|
|
601 -- Prevent displaying the same messages again in the future
|
|
|
602
|
|
|
603 First_Error_Msg := No_Error_Msg;
|
|
|
604 end Finalize;
|
|
|
605
|
|
|
606 ----------------
|
|
|
607 -- Initialize --
|
|
|
608 ----------------
|
|
|
609
|
|
|
610 procedure Initialize is
|
|
|
611 begin
|
|
|
612 Errors.Init;
|
|
|
613 First_Error_Msg := No_Error_Msg;
|
|
|
614 Last_Error_Msg := No_Error_Msg;
|
|
|
615 Serious_Errors_Detected := 0;
|
|
|
616 Total_Errors_Detected := 0;
|
|
|
617 Warnings_Detected := 0;
|
|
|
618 Warning_Info_Messages := 0;
|
|
|
619 Report_Info_Messages := 0;
|
|
|
620 Cur_Msg := No_Error_Msg;
|
|
|
621
|
|
|
622 -- Initialize warnings table, if all warnings are suppressed, supply
|
|
|
623 -- an initial dummy entry covering all possible source locations.
|
|
|
624
|
|
|
625 Warnings.Init;
|
|
|
626
|
|
|
627 if Warning_Mode = Suppress then
|
|
|
628 Warnings.Append
|
|
|
629 (New_Val =>
|
|
|
630 (Start => Source_Ptr'First,
|
|
|
631 Stop => Source_Ptr'Last,
|
|
|
632 Reason => Null_String_Id));
|
|
|
633 end if;
|
|
|
634 end Initialize;
|
|
|
635
|
|
|
636 ------------------------
|
|
|
637 -- Output_Source_Line --
|
|
|
638 ------------------------
|
|
|
639
|
|
|
640 procedure Output_Source_Line
|
|
|
641 (L : Physical_Line_Number;
|
|
|
642 Sfile : Source_File_Index;
|
|
|
643 Errs : Boolean;
|
|
|
644 Source_Type : String)
|
|
|
645 is
|
|
|
646 S : Source_Ptr;
|
|
|
647 C : Character;
|
|
|
648
|
|
|
649 Line_Number_Output : Boolean := False;
|
|
|
650 -- Set True once line number is output
|
|
|
651
|
|
|
652 begin
|
|
|
653 if Sfile /= Current_Error_Source_File then
|
|
|
654 Write_Str ("==============Error messages for ");
|
|
|
655 Write_Str (Source_Type);
|
|
|
656 Write_Str (" file: ");
|
|
|
657 Write_Name (Full_File_Name (Sfile));
|
|
|
658 Write_Eol;
|
|
|
659 Current_Error_Source_File := Sfile;
|
|
|
660 end if;
|
|
|
661
|
|
|
662 if Errs then
|
|
|
663 Output_Line_Number (Physical_To_Logical (L, Sfile));
|
|
|
664 Line_Number_Output := True;
|
|
|
665 end if;
|
|
|
666
|
|
|
667 S := Line_Start (L, Sfile);
|
|
|
668
|
|
|
669 loop
|
|
|
670 C := Source_Text (Sfile) (S);
|
|
|
671 exit when C = ASCII.LF or else C = ASCII.CR or else C = EOF;
|
|
|
672
|
|
|
673 if Errs then
|
|
|
674 Write_Char (C);
|
|
|
675 end if;
|
|
|
676
|
|
|
677 S := S + 1;
|
|
|
678 end loop;
|
|
|
679
|
|
|
680 if Line_Number_Output then
|
|
|
681 Write_Eol;
|
|
|
682 end if;
|
|
|
683 end Output_Source_Line;
|
|
|
684
|
|
|
685 -----------------------
|
|
|
686 -- Set_Ignore_Errors --
|
|
|
687 -----------------------
|
|
|
688
|
|
|
689 procedure Set_Ignore_Errors (To : Boolean) is
|
|
|
690 begin
|
|
|
691 Errors_Must_Be_Ignored := To;
|
|
|
692 end Set_Ignore_Errors;
|
|
|
693
|
|
|
694 ------------------------------
|
|
|
695 -- Set_Msg_Insertion_Column --
|
|
|
696 ------------------------------
|
|
|
697
|
|
|
698 procedure Set_Msg_Insertion_Column is
|
|
|
699 begin
|
|
|
700 if RM_Column_Check then
|
|
|
701 Set_Msg_Str (" in column ");
|
|
|
702 Set_Msg_Int (Int (Error_Msg_Col) + 1);
|
|
|
703 end if;
|
|
|
704 end Set_Msg_Insertion_Column;
|
|
|
705
|
|
|
706 ------------------
|
|
|
707 -- Set_Msg_Text --
|
|
|
708 ------------------
|
|
|
709
|
|
|
710 procedure Set_Msg_Text (Text : String; Flag : Source_Ptr) is
|
|
|
711 C : Character; -- Current character
|
|
|
712 P : Natural; -- Current index;
|
|
|
713
|
|
|
714 begin
|
|
|
715 Manual_Quote_Mode := False;
|
|
|
716 Msglen := 0;
|
|
|
717 Flag_Source := Get_Source_File_Index (Flag);
|
|
|
718 P := Text'First;
|
|
|
719
|
|
|
720 while P <= Text'Last loop
|
|
|
721 C := Text (P);
|
|
|
722 P := P + 1;
|
|
|
723
|
|
|
724 -- Check for insertion character
|
|
|
725
|
|
|
726 if C = '%' then
|
|
|
727 if P <= Text'Last and then Text (P) = '%' then
|
|
|
728 P := P + 1;
|
|
|
729 Set_Msg_Insertion_Name_Literal;
|
|
|
730 else
|
|
|
731 Set_Msg_Insertion_Name;
|
|
|
732 end if;
|
|
|
733
|
|
|
734 elsif C = '$' then
|
|
|
735
|
|
|
736 -- '$' is ignored
|
|
|
737
|
|
|
738 null;
|
|
|
739
|
|
|
740 elsif C = '{' then
|
|
|
741 Set_Msg_Insertion_File_Name;
|
|
|
742
|
|
|
743 elsif C = '}' then
|
|
|
744
|
|
|
745 -- '}' is ignored
|
|
|
746
|
|
|
747 null;
|
|
|
748
|
|
|
749 elsif C = '*' then
|
|
|
750 Set_Msg_Insertion_Reserved_Name;
|
|
|
751
|
|
|
752 elsif C = '&' then
|
|
|
753
|
|
|
754 -- '&' is ignored
|
|
|
755
|
|
|
756 null;
|
|
|
757
|
|
|
758 elsif C = '#' then
|
|
|
759 Set_Msg_Insertion_Line_Number (Error_Msg_Sloc, Flag);
|
|
|
760
|
|
|
761 elsif C = '\' then
|
|
|
762 Continuation := True;
|
|
|
763
|
|
|
764 elsif C = '@' then
|
|
|
765 Set_Msg_Insertion_Column;
|
|
|
766
|
|
|
767 elsif C = '^' then
|
|
|
768 Set_Msg_Insertion_Uint;
|
|
|
769
|
|
|
770 elsif C = '`' then
|
|
|
771 Manual_Quote_Mode := not Manual_Quote_Mode;
|
|
|
772 Set_Msg_Char ('"');
|
|
|
773
|
|
|
774 elsif C = '!' then
|
|
|
775 null;
|
|
|
776
|
|
|
777 elsif C = '?' then
|
|
|
778 null;
|
|
|
779
|
|
|
780 elsif C = '<' then
|
|
|
781 null;
|
|
|
782
|
|
|
783 elsif C = '|' then
|
|
|
784 null;
|
|
|
785
|
|
|
786 elsif C = ''' then
|
|
|
787 Set_Msg_Char (Text (P));
|
|
|
788 P := P + 1;
|
|
|
789
|
|
|
790 -- Upper case letter (start of reserved word if 2 or more)
|
|
|
791
|
|
|
792 elsif C in 'A' .. 'Z'
|
|
|
793 and then P <= Text'Last
|
|
|
794 and then Text (P) in 'A' .. 'Z'
|
|
|
795 then
|
|
|
796 P := P - 1;
|
|
|
797 Set_Msg_Insertion_Reserved_Word (Text, P);
|
|
|
798
|
|
|
799 elsif C = '~' then
|
|
|
800 Set_Msg_Str (Error_Msg_String (1 .. Error_Msg_Strlen));
|
|
|
801
|
|
|
802 -- Normal character with no special treatment
|
|
|
803
|
|
|
804 else
|
|
|
805 Set_Msg_Char (C);
|
|
|
806 end if;
|
|
|
807
|
|
|
808 end loop;
|
|
|
809 end Set_Msg_Text;
|
|
|
810
|
|
|
811 end Errutil;
|
