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