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