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