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 is not
 188       --  the first error message. The philosophy is that if we get a weird
 189       --  error message and we already have had a message, then we hope the
 190       --  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, don't
 250          --  delete continuation lines (we attempted to delete those earlier
 251          --  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 an error.
 258             --  This is because we don't want a real error masked by a warning.
 259             --  In all other cases (that is parse errors for the same line that
 260             --  are not unconditional) we do delete the message. This helps to
 261             --  avoid junk extra messages from cascaded parsing errors
 262
 263             if not (Errors.Table (Prev_Msg).Warn
 264                       or
 265                     Errors.Table (Prev_Msg).Style)
 266               or else
 267                    (Errors.Table (Cur_Msg).Warn
 268                       or
 269                     Errors.Table (Cur_Msg).Style)
 270             then
 271                --  All tests passed, delete the message by simply returning
 272                --  without any further processing.
 273
 274                if not Continuation then
 275                   Last_Killed := True;
 276                end if;
 277
 278                return;
 279             end if;
 280          end if;
 281       end if;
 282
 283       --  Come here if message is to be inserted in the error chain
 284
 285       if not Continuation then
 286          Last_Killed := False;
 287       end if;
 288
 289       if Prev_Msg = No_Error_Msg then
 290          First_Error_Msg := Cur_Msg;
 291       else
 292          Errors.Table (Prev_Msg).Next := Cur_Msg;
 293       end if;
 294
 295       Errors.Table (Cur_Msg).Next := Next_Msg;
 296
 297       --  Bump appropriate statistics count
 298
 299       if Errors.Table (Cur_Msg).Warn or Errors.Table (Cur_Msg).Style then
 300          Warnings_Detected := Warnings_Detected + 1;
 301       else
 302          Total_Errors_Detected := Total_Errors_Detected + 1;
 303
 304          if Errors.Table (Cur_Msg).Serious then
 305             Serious_Errors_Detected := Serious_Errors_Detected + 1;
 306          end if;
 307       end if;
 308
 309    end Error_Msg;
 310
 311    -----------------
 312    -- Error_Msg_S --
 313    -----------------
 314
 315    procedure Error_Msg_S (Msg : String) is
 316    begin
 317       Error_Msg (Msg, Scan_Ptr);
 318    end Error_Msg_S;
 319
 320    ------------------
 321    -- Error_Msg_SC --
 322    ------------------
 323
 324    procedure Error_Msg_SC (Msg : String) is
 325    begin
 326       --  If we are at end of file, post the flag after the previous token
 327
 328       if Token = Tok_EOF then
 329          Error_Msg_AP (Msg);
 330
 331       --  For all other cases the message is posted at the current token
 332       --  pointer position
 333
 334       else
 335          Error_Msg (Msg, Token_Ptr);
 336       end if;
 337    end Error_Msg_SC;
 338
 339    ------------------
 340    -- Error_Msg_SP --
 341    ------------------
 342
 343    procedure Error_Msg_SP (Msg : String) is
 344    begin
 345       --  Note: in the case where there is no previous token, Prev_Token_Ptr
 346       --  is set to Source_First, which is a reasonable position for the
 347       --  error flag in this situation
 348
 349       Error_Msg (Msg, Prev_Token_Ptr);
 350    end Error_Msg_SP;
 351
 352    --------------
 353    -- Finalize --
 354    --------------
 355
 356    procedure Finalize (Source_Type : String := "project") is
 357       Cur      : Error_Msg_Id;
 358       Nxt      : Error_Msg_Id;
 359       E, F     : Error_Msg_Id;
 360       Err_Flag : Boolean;
 361
 362    begin
 363       --  Eliminate any duplicated error messages from the list. This is
 364       --  done after the fact to avoid problems with Change_Error_Text.
 365
 366       Cur := First_Error_Msg;
 367       while Cur /= No_Error_Msg loop
 368          Nxt := Errors.Table (Cur).Next;
 369
 370          F := Nxt;
 371          while F /= No_Error_Msg
 372            and then Errors.Table (F).Sptr = Errors.Table (Cur).Sptr
 373          loop
 374             Check_Duplicate_Message (Cur, F);
 375             F := Errors.Table (F).Next;
 376          end loop;
 377
 378          Cur := Nxt;
 379       end loop;
 380
 381       --  Brief Error mode
 382
 383       if Brief_Output or (not Full_List and not Verbose_Mode) then
 384          E := First_Error_Msg;
 385          Set_Standard_Error;
 386
 387          while E /= No_Error_Msg loop
 388             if not Errors.Table (E).Deleted then
 389                if Full_Path_Name_For_Brief_Errors then
 390                   Write_Name (Full_Ref_Name (Errors.Table (E).Sfile));
 391                else
 392                   Write_Name (Reference_Name (Errors.Table (E).Sfile));
 393                end if;
 394
 395                Write_Char (':');
 396                Write_Int (Int (Physical_To_Logical
 397                                 (Errors.Table (E).Line,
 398                                  Errors.Table (E).Sfile)));
 399                Write_Char (':');
 400
 401                if Errors.Table (E).Col < 10 then
 402                   Write_Char ('0');
 403                end if;
 404
 405                Write_Int (Int (Errors.Table (E).Col));
 406                Write_Str (": ");
 407                Output_Msg_Text (E);
 408                Write_Eol;
 409             end if;
 410
 411             E := Errors.Table (E).Next;
 412          end loop;
 413
 414          Set_Standard_Output;
 415       end if;
 416
 417       --  Full source listing case
 418
 419       if Full_List then
 420          List_Pragmas_Index := 1;
 421          List_Pragmas_Mode := True;
 422          E := First_Error_Msg;
 423          Write_Eol;
 424
 425          --  First list initial main source file with its error messages
 426
 427          for N in 1 .. Last_Source_Line (Main_Source_File) loop
 428             Err_Flag :=
 429               E /= No_Error_Msg
 430                 and then Errors.Table (E).Line = N
 431                 and then Errors.Table (E).Sfile = Main_Source_File;
 432
 433             Output_Source_Line (N, Main_Source_File, Err_Flag, Source_Type);
 434
 435             if Err_Flag then
 436                Output_Error_Msgs (E);
 437
 438                Write_Eol;
 439             end if;
 440          end loop;
 441
 442          --  Then output errors, if any, for subsidiary units
 443
 444          while E /= No_Error_Msg
 445            and then Errors.Table (E).Sfile /= Main_Source_File
 446          loop
 447             Write_Eol;
 448             Output_Source_Line
 449               (Errors.Table (E).Line,
 450                Errors.Table (E).Sfile,
 451                True,
 452                Source_Type);
 453             Output_Error_Msgs (E);
 454          end loop;
 455       end if;
 456
 457       --  Verbose mode (error lines only with error flags)
 458
 459       if Verbose_Mode then
 460          E := First_Error_Msg;
 461
 462          --  Loop through error lines
 463
 464          while E /= No_Error_Msg loop
 465             Write_Eol;
 466             Output_Source_Line
 467               (Errors.Table (E).Line,
 468                Errors.Table (E).Sfile,
 469                True,
 470                Source_Type);
 471             Output_Error_Msgs (E);
 472          end loop;
 473       end if;
 474
 475       --  Output error summary if verbose or full list mode
 476
 477       if Verbose_Mode or else Full_List then
 478
 479          --  Extra blank line if error messages or source listing were output
 480
 481          if Total_Errors_Detected + Warnings_Detected > 0
 482            or else Full_List
 483          then
 484             Write_Eol;
 485          end if;
 486
 487          --  Message giving number of lines read and number of errors detected.
 488          --  This normally goes to Standard_Output. The exception is when brief
 489          --  mode is not set, verbose mode (or full list mode) is set, and
 490          --  there are errors. In this case we send the message to standard
 491          --  error to make sure that *something* appears on standard error in
 492          --  an error situation.
 493
 494          --  Formerly, only the "# errors" suffix was sent to stderr, whereas
 495          --  "# lines:" appeared on stdout. This caused problems on VMS when
 496          --  the stdout buffer was flushed, giving an extra line feed after
 497          --  the prefix.
 498
 499          if Total_Errors_Detected + Warnings_Detected /= 0
 500            and then not Brief_Output
 501            and then (Verbose_Mode or Full_List)
 502          then
 503             Set_Standard_Error;
 504          end if;
 505
 506          --  Message giving total number of lines
 507
 508          Write_Str (" ");
 509          Write_Int (Num_Source_Lines (Main_Source_File));
 510
 511          if Num_Source_Lines (Main_Source_File) = 1 then
 512             Write_Str (" line: ");
 513          else
 514             Write_Str (" lines: ");
 515          end if;
 516
 517          if Total_Errors_Detected = 0 then
 518             Write_Str ("No errors");
 519
 520          elsif Total_Errors_Detected = 1 then
 521             Write_Str ("1 error");
 522
 523          else
 524             Write_Int (Total_Errors_Detected);
 525             Write_Str (" errors");
 526          end if;
 527
 528          if Warnings_Detected /= 0 then
 529             Write_Str (", ");
 530             Write_Int (Warnings_Detected);
 531             Write_Str (" warning");
 532
 533             if Warnings_Detected /= 1 then
 534                Write_Char ('s');
 535             end if;
 536
 537             if Warning_Mode = Treat_As_Error then
 538                Write_Str (" (treated as error");
 539
 540                if Warnings_Detected /= 1 then
 541                   Write_Char ('s');
 542                end if;
 543
 544                Write_Char (')');
 545             end if;
 546          end if;
 547
 548          Write_Eol;
 549          Set_Standard_Output;
 550       end if;
 551
 552       if Maximum_Errors /= 0
 553         and then Total_Errors_Detected + Warnings_Detected = Maximum_Errors
 554       then
 555          Set_Standard_Error;
 556          Write_Str ("fatal error: maximum errors reached");
 557          Write_Eol;
 558          Set_Standard_Output;
 559       end if;
 560
 561       if Warning_Mode = Treat_As_Error then
 562          Total_Errors_Detected := Total_Errors_Detected + Warnings_Detected;
 563          Warnings_Detected := 0;
 564       end if;
 565    end Finalize;
 566
 567    ----------------
 568    -- Initialize --
 569    ----------------
 570
 571    procedure Initialize is
 572    begin
 573       Errors.Init;
 574       First_Error_Msg := No_Error_Msg;
 575       Last_Error_Msg  := No_Error_Msg;
 576       Serious_Errors_Detected := 0;
 577       Total_Errors_Detected := 0;
 578       Warnings_Detected := 0;
 579       Cur_Msg := No_Error_Msg;
 580
 581       --  Initialize warnings table, if all warnings are suppressed, supply
 582       --  an initial dummy entry covering all possible source locations.
 583
 584       Warnings.Init;
 585    end Initialize;
 586
 587    ------------------------
 588    -- Output_Source_Line --
 589    ------------------------
 590
 591    procedure Output_Source_Line
 592      (L           : Physical_Line_Number;
 593       Sfile       : Source_File_Index;
 594       Errs        : Boolean;
 595       Source_Type : String)
 596    is
 597       S : Source_Ptr;
 598       C : Character;
 599
 600       Line_Number_Output : Boolean := False;
 601       --  Set True once line number is output
 602
 603    begin
 604       if Sfile /= Current_Error_Source_File then
 605          Write_Str ("==============Error messages for ");
 606          Write_Str (Source_Type);
 607          Write_Str (" file: ");
 608          Write_Name (Full_File_Name (Sfile));
 609          Write_Eol;
 610          Current_Error_Source_File := Sfile;
 611       end if;
 612
 613       if Errs then
 614          Output_Line_Number (Physical_To_Logical (L, Sfile));
 615          Line_Number_Output := True;
 616       end if;
 617
 618       S := Line_Start (L, Sfile);
 619
 620       loop
 621          C := Source_Text (Sfile) (S);
 622          exit when C = ASCII.LF or else C = ASCII.CR or else C = EOF;
 623
 624          if Errs then
 625             Write_Char (C);
 626          end if;
 627
 628          S := S + 1;
 629       end loop;
 630
 631       if Line_Number_Output then
 632          Write_Eol;
 633       end if;
 634    end Output_Source_Line;
 635
 636    -----------------------
 637    -- Set_Ignore_Errors --
 638    -----------------------
 639
 640    procedure Set_Ignore_Errors (To : Boolean) is
 641    begin
 642       Errors_Must_Be_Ignored := To;
 643    end Set_Ignore_Errors;
 644
 645    ------------------------------
 646    -- Set_Msg_Insertion_Column --
 647    ------------------------------
 648
 649    procedure Set_Msg_Insertion_Column is
 650    begin
 651       if Style.RM_Column_Check then
 652          Set_Msg_Str (" in column ");
 653          Set_Msg_Int (Int (Error_Msg_Col) + 1);
 654       end if;
 655    end Set_Msg_Insertion_Column;
 656
 657    ------------------
 658    -- Set_Msg_Text --
 659    ------------------
 660
 661    procedure Set_Msg_Text (Text : String; Flag : Source_Ptr) is
 662       C : Character;         -- Current character
 663       P : Natural;           -- Current index;
 664
 665    begin
 666       Manual_Quote_Mode := False;
 667       Msglen := 0;
 668       Flag_Source := Get_Source_File_Index (Flag);
 669       P := Text'First;
 670
 671       while P <= Text'Last loop
 672          C := Text (P);
 673          P := P + 1;
 674
 675          --  Check for insertion character
 676
 677          if C = '%' then
 678             Set_Msg_Insertion_Name;
 679
 680          elsif C = '$' then
 681
 682             --  '$' is ignored
 683
 684             null;
 685
 686          elsif C = '{' then
 687             Set_Msg_Insertion_File_Name;
 688
 689          elsif C = '}' then
 690
 691             --  '}' is ignored
 692
 693             null;
 694
 695          elsif C = '*' then
 696             Set_Msg_Insertion_Reserved_Name;
 697
 698          elsif C = '&' then
 699
 700             --  '&' is ignored
 701
 702             null;
 703
 704          elsif C = '#' then
 705             Set_Msg_Insertion_Line_Number (Error_Msg_Sloc, Flag);
 706
 707          elsif C = '\' then
 708             Continuation := True;
 709
 710          elsif C = '@' then
 711             Set_Msg_Insertion_Column;
 712
 713          elsif C = '^' then
 714             Set_Msg_Insertion_Uint;
 715
 716          elsif C = '`' then
 717             Manual_Quote_Mode := not Manual_Quote_Mode;
 718             Set_Msg_Char ('"');
 719
 720          elsif C = '!' then
 721             Is_Unconditional_Msg := True;
 722
 723          elsif C = '?' then
 724             null;
 725
 726          elsif C = '<' then
 727             null;
 728
 729          elsif C = '|' then
 730             null;
 731
 732          elsif C = ''' then
 733             Set_Msg_Char (Text (P));
 734             P := P + 1;
 735
 736          --  Upper case letter (start of reserved word if 2 or more)
 737
 738          elsif C in 'A' .. 'Z'
 739            and then P <= Text'Last
 740            and then Text (P) in 'A' .. 'Z'
 741          then
 742             P := P - 1;
 743             Set_Msg_Insertion_Reserved_Word (Text, P);
 744
 745          --  Normal character with no special treatment
 746
 747          else
 748             Set_Msg_Char (C);
 749          end if;
 750
 751       end loop;
 752    end Set_Msg_Text;
 753
 754 end Errutil;