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