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