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