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