GCC v8.2
[gcc.git] / gcc / ada / errutil.adb
1 ------------------------------------------------------------------------------
2 --                                                                          --
3 --                         GNAT COMPILER COMPONENTS                         --
4 --                                                                          --
5 --                              E R R U T I L                               --
6 --                                                                          --
7 --                                 B o d y                                  --
8 --                                                                          --
9 --          Copyright (C) 1991-2018, Free Software Foundation, Inc.         --
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;