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