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