1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- E R R O U T C -- 6-- -- 7-- S p e c -- 8-- -- 9-- Copyright (C) 1992-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 26-- This packages contains global variables and routines common to error 27-- reporting packages, including Errout and Prj.Err. 28 29with Table; 30with Types; use Types; 31 32package Erroutc is 33 34 Class_Flag : Boolean := False; 35 -- This flag is set True when outputting a reference to a class-wide 36 -- type, and is used by Add_Class to insert 'Class at the proper point 37 38 Continuation : Boolean := False; 39 -- Indicates if current message is a continuation. Initialized from the 40 -- Msg_Cont parameter in Error_Msg_Internal and then set True if a \ 41 -- insertion character is encountered. 42 43 Continuation_New_Line : Boolean := False; 44 -- Indicates if current message was a continuation line marked with \\ to 45 -- force a new line. Set True if \\ encountered. 46 47 Flag_Source : Source_File_Index; 48 -- Source file index for source file where error is being posted 49 50 Has_Double_Exclam : Boolean := False; 51 -- Set true to indicate that the current message contains the insertion 52 -- sequence !! (force warnings even in non-main unit source files). 53 54 Has_Insertion_Line : Boolean := False; 55 -- Set True to indicate that the current message contains the insertion 56 -- character # (insert line number reference). 57 58 Is_Compile_Time_Msg : Boolean := False; 59 -- Set true to indicate that the current message originates from a 60 -- Compile_Time_Warning or Compile_Time_Error pragma. 61 62 Is_Serious_Error : Boolean := False; 63 -- Set True for a serious error (i.e. any message that is not a warning 64 -- or style message, and that does not contain a | insertion character). 65 66 Is_Unconditional_Msg : Boolean := False; 67 -- Set True to indicate that the current message contains the insertion 68 -- character ! and is thus to be treated as an unconditional message. 69 70 Is_Warning_Msg : Boolean := False; 71 -- Set True to indicate if current message is warning message (contains ? 72 -- or contains < and Error_Msg_Warn is True. 73 74 Is_Info_Msg : Boolean := False; 75 -- Set True to indicate that the current message starts with the characters 76 -- "info: " and is to be treated as an information message. This string 77 -- will be prepended to the message and all its continuations. 78 79 Is_Check_Msg : Boolean := False; 80 -- Set True to indicate that the current message starts with one of 81 -- "high: ", "medium: ", "low: " and is to be treated as a check message. 82 83 Warning_Msg_Char : String (1 .. 2); 84 -- Warning switch, valid only if Is_Warning_Msg is True 85 -- " " -- ? or < appeared on its own in message 86 -- "? " -- ?? or << appeared in message 87 -- "x " -- ?x? or <x< appeared in message 88 -- -- (x = a .. z | A .. Z | * | $) 89 -- ".x" -- ?.x? appeared in message (x = a .. z | A .. Z) 90 -- "_x" -- ?_x? appeared in message (x = a .. z | A .. Z) 91 -- In the case of the < sequences, this is set only if the message is 92 -- actually a warning, i.e. if Error_Msg_Warn is True 93 94 Is_Style_Msg : Boolean := False; 95 -- Set True to indicate if the current message is a style message 96 -- (i.e. a message whose text starts with the characters "(style)"). 97 98 Kill_Message : Boolean := False; 99 -- A flag used to kill weird messages (e.g. those containing uninterpreted 100 -- implicit type references) if we have already seen at least one message 101 -- already. The idea is that we hope the weird message is a junk cascaded 102 -- message that should be suppressed. 103 104 Last_Killed : Boolean := False; 105 -- Set True if the most recently posted non-continuation message was 106 -- killed. This is used to determine the processing of any continuation 107 -- messages that follow. 108 109 List_Pragmas_Index : Int := 0; 110 -- Index into List_Pragmas table 111 112 List_Pragmas_Mode : Boolean := False; 113 -- Starts True, gets set False by pragma List (Off), True by List (On) 114 115 Manual_Quote_Mode : Boolean := False; 116 -- Set True in manual quotation mode 117 118 Max_Msg_Length : constant := 1024 + 2 * Int (Column_Number'Last); 119 -- Maximum length of error message. The addition of 2 * Column_Number'Last 120 -- ensures that two insertion tokens of maximum length can be accommodated. 121 -- The value of 1024 is an arbitrary value that should be more than long 122 -- enough to accommodate any reasonable message (and for that matter, some 123 -- pretty unreasonable messages). 124 125 Msg_Buffer : String (1 .. Max_Msg_Length); 126 -- Buffer used to prepare error messages 127 128 Msglen : Integer := 0; 129 -- Number of characters currently stored in the message buffer 130 131 Suppress_Message : Boolean; 132 -- A flag used to suppress certain obviously redundant messages (i.e. 133 -- those referring to a node whose type is Any_Type). This suppression 134 -- is effective only if All_Errors_Mode is off. 135 136 Suppress_Instance_Location : Boolean := False; 137 -- Normally, if a # location in a message references a location within 138 -- a generic template, then a note is added giving the location of the 139 -- instantiation. If this variable is set True, then this note is not 140 -- output. This is used for internal processing for the case of an 141 -- illegal instantiation. See Error_Msg routine for further details. 142 143 type Subprogram_Name_Type is access function (N : Node_Id) return String; 144 Subprogram_Name_Ptr : Subprogram_Name_Type; 145 -- Indirect call to Sem_Util.Subprogram_Name to break circular 146 -- dependency with the static elaboration model. 147 148 ---------------------------- 149 -- Message ID Definitions -- 150 ---------------------------- 151 152 type Error_Msg_Id is new Int; 153 -- A type used to represent specific error messages. Used by the clients 154 -- of this package only in the context of the Get_Error_Id and 155 -- Change_Error_Text subprograms. 156 157 No_Error_Msg : constant Error_Msg_Id := 0; 158 -- A constant which is different from any value returned by Get_Error_Id. 159 -- Typically used by a client to indicate absence of a saved Id value. 160 161 Cur_Msg : Error_Msg_Id := No_Error_Msg; 162 -- Id of most recently posted error message 163 164 function Get_Msg_Id return Error_Msg_Id; 165 -- Returns the Id of the message most recently posted using one of the 166 -- Error_Msg routines. 167 168 function Get_Location (E : Error_Msg_Id) return Source_Ptr; 169 -- Returns the flag location of the error message with the given id E 170 171 ----------------------------------- 172 -- Error Message Data Structures -- 173 ----------------------------------- 174 175 -- The error messages are stored as a linked list of error message objects 176 -- sorted into ascending order by the source location (Sloc). Each object 177 -- records the text of the message and its source location. 178 179 -- The following record type and table are used to represent error 180 -- messages, with one entry in the table being allocated for each message. 181 182 type Error_Msg_Object is record 183 Text : String_Ptr; 184 -- Text of error message, fully expanded with all insertions 185 186 Next : Error_Msg_Id; 187 -- Pointer to next message in error chain. A value of No_Error_Msg 188 -- indicates the end of the chain. 189 190 Prev : Error_Msg_Id; 191 -- Pointer to previous message in error chain. Only set during the 192 -- Finalize procedure. A value of No_Error_Msg indicates the first 193 -- message in the chain. 194 195 Sfile : Source_File_Index; 196 -- Source table index of source file. In the case of an error that 197 -- refers to a template, always references the original template 198 -- not an instantiation copy. 199 200 Sptr : Source_Span; 201 -- Flag pointer. In the case of an error that refers to a template, 202 -- always references the original template, not an instantiation copy. 203 -- This value is the actual place in the source that the error message 204 -- will be posted. Note that an error placed on an instantiation will 205 -- have Sptr pointing to the instantiation point. 206 207 Optr : Source_Ptr; 208 -- Flag location used in the call to post the error. This is the same as 209 -- Sptr, except when an error is posted on a particular instantiation of 210 -- a generic. In such a case, Sptr will point to the original source 211 -- location of the instantiation itself, but Optr will point to the 212 -- template location (more accurately to the template copy in the 213 -- instantiation copy corresponding to the instantiation referenced by 214 -- Sptr). 215 216 Insertion_Sloc : Source_Ptr; 217 -- Location in message for insertion character # when used 218 219 Line : Physical_Line_Number; 220 -- Line number for error message 221 222 Col : Column_Number; 223 -- Column number for error message 224 225 Compile_Time_Pragma : Boolean; 226 -- True if the message originates from a Compile_Time_Warning or 227 -- Compile_Time_Error pragma 228 229 Warn : Boolean; 230 -- True if warning message 231 232 Info : Boolean; 233 -- True if info message 234 235 Check : Boolean; 236 -- True if check message 237 238 Warn_Err : Boolean; 239 -- True if this is a warning message which is to be treated as an error 240 -- as a result of a match with a Warning_As_Error pragma. 241 242 Warn_Chr : String (1 .. 2); 243 -- See Warning_Msg_Char 244 245 Style : Boolean; 246 -- True if style message (starts with "(style)") 247 248 Serious : Boolean; 249 -- True if serious error message (not a warning and no | character) 250 251 Uncond : Boolean; 252 -- True if unconditional message (i.e. insertion character ! appeared) 253 254 Msg_Cont : Boolean; 255 -- This is used for logical messages that are composed of multiple 256 -- individual messages. For messages that are not part of such a 257 -- group, or that are the first message in such a group. Msg_Cont 258 -- is set to False. For subsequent messages in a group, Msg_Cont 259 -- is set to True. This is used to make sure that such a group of 260 -- messages is either suppressed or retained as a group (e.g. in 261 -- the circuit that deletes identical messages). 262 263 Deleted : Boolean; 264 -- If this flag is set, the message is not printed. This is used 265 -- in the circuit for deleting duplicate/redundant error messages. 266 267 Node : Node_Id; 268 -- If set, points to the node relevant for this message which will be 269 -- used to compute the enclosing subprogram name if 270 -- Opt.Include_Subprogram_In_Messages is set. 271 end record; 272 273 package Errors is new Table.Table ( 274 Table_Component_Type => Error_Msg_Object, 275 Table_Index_Type => Error_Msg_Id, 276 Table_Low_Bound => 1, 277 Table_Initial => 200, 278 Table_Increment => 200, 279 Table_Name => "Error"); 280 281 First_Error_Msg : Error_Msg_Id; 282 -- The list of error messages, i.e. the first entry on the list of error 283 -- messages. This is not the same as the physically first entry in the 284 -- error message table, since messages are not always inserted in sequence. 285 286 Last_Error_Msg : Error_Msg_Id; 287 -- The last entry on the list of error messages. Note: this is not the same 288 -- as the physically last entry in the error message table, since messages 289 -- are not always inserted in sequence. 290 291 -------------------------- 292 -- Warning Mode Control -- 293 -------------------------- 294 295 -- Pragma Warnings allows warnings to be turned off for a specified region 296 -- of code, and the following tables are the data structures used to keep 297 -- track of these regions. 298 299 -- The first table is used for the basic command line control, and for the 300 -- forms of Warning with a single ON or OFF parameter. 301 302 -- It contains pairs of source locations, the first being the start 303 -- location for a warnings off region, and the second being the end 304 -- location. When a pragma Warnings (Off) is encountered, a new entry is 305 -- established extending from the location of the pragma to the end of the 306 -- current source file. A subsequent pragma Warnings (On) adjusts the end 307 -- point of this entry appropriately. 308 309 -- If all warnings are suppressed by command switch, then there is a dummy 310 -- entry (put there by Errout.Initialize) at the start of the table which 311 -- covers all possible Source_Ptr values. Note that the source pointer 312 -- values in this table always reference the original template, not an 313 -- instantiation copy, in the generic case. 314 315 -- Reason is the reason from the pragma Warnings (Off,..) or the null 316 -- string if no reason parameter is given. 317 318 type Warnings_Entry is record 319 Start : Source_Ptr; 320 Stop : Source_Ptr; 321 Reason : String_Id; 322 end record; 323 324 package Warnings is new Table.Table ( 325 Table_Component_Type => Warnings_Entry, 326 Table_Index_Type => Natural, 327 Table_Low_Bound => 1, 328 Table_Initial => 100, 329 Table_Increment => 200, 330 Table_Name => "Warnings"); 331 332 -- The second table is used for the specific forms of the pragma, where 333 -- the first argument is ON or OFF, and the second parameter is a string 334 -- which is the pattern to match for suppressing a warning. 335 336 type Specific_Warning_Entry is record 337 Start : Source_Ptr; 338 Stop : Source_Ptr; 339 -- Starting and ending source pointers for the range. These are always 340 -- from the same source file. 341 342 Reason : String_Id; 343 -- Reason string from pragma Warnings, or null string if none 344 345 Msg : String_Ptr; 346 -- Message from pragma Warnings (Off, string) 347 348 Open : Boolean; 349 -- Set to True if OFF has been encountered with no matching ON 350 351 Used : Boolean; 352 -- Set to True if entry has been used to suppress a warning 353 354 Config : Boolean; 355 -- True if pragma is configuration pragma (in which case no matching Off 356 -- pragma is required, and it is not required that a specific warning be 357 -- suppressed). 358 end record; 359 360 package Specific_Warnings is new Table.Table ( 361 Table_Component_Type => Specific_Warning_Entry, 362 Table_Index_Type => Natural, 363 Table_Low_Bound => 1, 364 Table_Initial => 100, 365 Table_Increment => 200, 366 Table_Name => "Specific_Warnings"); 367 368 -- Note on handling configuration case versus specific case. A complication 369 -- arises from this example: 370 371 -- pragma Warnings (Off, "not referenced*"); 372 -- procedure Mumble (X : Integer) is 373 -- pragma Warnings (On, "not referenced*"); 374 -- begin 375 -- null; 376 -- end Mumble; 377 378 -- The trouble is that the first pragma is technically a configuration 379 -- pragma, and yet it is clearly being used in the context of thinking of 380 -- it as a specific case. To deal with this, what we do is that the On 381 -- entry can match a configuration pragma from the same file, and if we 382 -- find such an On entry, we cancel the indication of it being the 383 -- configuration case. This seems to handle all cases we run into ok. 384 385 ------------------- 386 -- Color Control -- 387 ------------------- 388 389 Use_SGR_Control : Boolean := False; 390 -- Set to True for enabling colored output. This should only be done when 391 -- outputting messages to a terminal that supports it. 392 393 -- Colors in messages output to a terminal are controlled using SGR 394 -- (Select Graphic Rendition). 395 396 Color_Separator : constant String := ";"; 397 Color_None : constant String := "00"; 398 Color_Bold : constant String := "01"; 399 Color_Underscore : constant String := "04"; 400 Color_Blink : constant String := "05"; 401 Color_Reverse : constant String := "07"; 402 Color_Fg_Black : constant String := "30"; 403 Color_Fg_Red : constant String := "31"; 404 Color_Fg_Green : constant String := "32"; 405 Color_Fg_Yellow : constant String := "33"; 406 Color_Fg_Blue : constant String := "34"; 407 Color_Fg_Magenta : constant String := "35"; 408 Color_Fg_Cyan : constant String := "36"; 409 Color_Fg_White : constant String := "37"; 410 Color_Bg_Black : constant String := "40"; 411 Color_Bg_Red : constant String := "41"; 412 Color_Bg_Green : constant String := "42"; 413 Color_Bg_Yellow : constant String := "43"; 414 Color_Bg_Blue : constant String := "44"; 415 Color_Bg_Magenta : constant String := "45"; 416 Color_Bg_Cyan : constant String := "46"; 417 Color_Bg_White : constant String := "47"; 418 419 SGR_Start : constant String := ASCII.ESC & "["; 420 SGR_End : constant String := "m" & ASCII.ESC & "[K"; 421 422 function SGR_Seq (Str : String) return String is 423 (if Use_SGR_Control then SGR_Start & Str & SGR_End else ""); 424 -- Return the SGR control string for the commands in Str. It returns the 425 -- empty string if Use_SGR_Control is False, so that we can insert this 426 -- string unconditionally. 427 428 function SGR_Reset return String is (SGR_Seq ("")); 429 -- This ends the current section of colored output 430 431 -- We're using the same colors as gcc/g++ for errors/warnings/notes/locus. 432 -- More colors are defined in gcc/g++ for other features of diagnostic 433 -- messages (e.g. inline types, fixit) and could be used in GNAT in the 434 -- future. The following functions start a section of colored output. 435 436 function SGR_Error return String is 437 (SGR_Seq (Color_Bold & Color_Separator & Color_Fg_Red)); 438 function SGR_Warning return String is 439 (SGR_Seq (Color_Bold & Color_Separator & Color_Fg_Magenta)); 440 function SGR_Note return String is 441 (SGR_Seq (Color_Bold & Color_Separator & Color_Fg_Cyan)); 442 function SGR_Locus return String is 443 (SGR_Seq (Color_Bold)); 444 445 ----------------- 446 -- Subprograms -- 447 ----------------- 448 449 procedure Add_Class; 450 -- Add 'Class to buffer for class wide type case (Class_Flag set) 451 452 function Buffer_Ends_With (C : Character) return Boolean; 453 -- Tests if message buffer ends with given character 454 455 function Buffer_Ends_With (S : String) return Boolean; 456 -- Tests if message buffer ends with given string preceded by a space 457 458 procedure Buffer_Remove (C : Character); 459 -- Remove given character fron end of buffer if it is present 460 461 procedure Buffer_Remove (S : String); 462 -- Removes given string from end of buffer if it is present at end of 463 -- buffer, and preceded by a space. 464 465 function Compilation_Errors return Boolean; 466 -- Returns true if errors have been detected, or warnings in -gnatwe 467 -- (treat warnings as errors) mode. 468 469 procedure dmsg (Id : Error_Msg_Id); 470 -- Debugging routine to dump an error message 471 472 procedure Debug_Output (N : Node_Id); 473 -- Called from Error_Msg_N and Error_Msg_NE to generate line of debug 474 -- output giving node number (of node N) if the debug X switch is set. 475 476 procedure Check_Duplicate_Message (M1, M2 : Error_Msg_Id); 477 -- This function is passed the Id values of two error messages. If either 478 -- M1 or M2 is a continuation message, or is already deleted, the call is 479 -- ignored. Otherwise a check is made to see if M1 and M2 are duplicated or 480 -- redundant. If so, the message to be deleted and all its continuations 481 -- are marked with the Deleted flag set to True. 482 483 function Count_Compile_Time_Pragma_Warnings return Int; 484 -- Returns the number of warnings in the Errors table that were triggered 485 -- by a Compile_Time_Warning pragma. 486 487 function Get_Warning_Tag (Id : Error_Msg_Id) return String; 488 -- Given an error message ID, return tag showing warning message class, or 489 -- the null string if this option is not enabled or this is not a warning. 490 491 function Matches (S : String; P : String) return Boolean; 492 -- Returns true if the String S matches the pattern P, which can contain 493 -- wildcard chars (*). The entire pattern must match the entire string. 494 -- Case is ignored in the comparison (so X matches x). 495 496 procedure Output_Error_Msgs (E : in out Error_Msg_Id); 497 -- Output source line, error flag, and text of stored error message and all 498 -- subsequent messages for the same line and unit. On return E is set to be 499 -- one higher than the last message output. 500 501 procedure Output_Line_Number (L : Logical_Line_Number); 502 -- Output a line number as six digits (with leading zeroes suppressed), 503 -- followed by a period and a blank (note that this is 8 characters which 504 -- means that tabs in the source line will not get messed up). Line numbers 505 -- that match or are less than the last Source_Reference pragma are listed 506 -- as all blanks, avoiding output of junk line numbers. 507 508 procedure Output_Msg_Text (E : Error_Msg_Id); 509 -- Outputs characters of text in the text of the error message E. Note that 510 -- no end of line is output, the caller is responsible for adding the end 511 -- of line. If Error_Msg_Line_Length is non-zero, this is the routine that 512 -- splits the line generating multiple lines of output, and in this case 513 -- the last line has no terminating end of line character. 514 515 procedure Prescan_Message (Msg : String); 516 -- Scans message text and sets the following variables: 517 -- 518 -- Is_Warning_Msg is set True if Msg is a warning message (contains a 519 -- question mark character), and False otherwise. 520 -- 521 -- Is_Style_Msg is set True if Msg is a style message (starts with 522 -- "(style)") and False otherwise. 523 -- 524 -- Is_Info_Msg is set True if Msg is an information message (starts 525 -- with "info: ". Such messages must contain a ? sequence since they 526 -- are also considered to be warning messages, and get a tag. 527 -- 528 -- Is_Serious_Error is set to True unless the message is a warning or 529 -- style message or contains the character | (non-serious error). 530 -- 531 -- Is_Unconditional_Msg is set True if the message contains the character 532 -- ! and is otherwise set False. 533 -- 534 -- Has_Double_Exclam is set True if the message contains the sequence !! 535 -- and is otherwise set False. 536 -- 537 -- Has_Insertion_Line is set True if the message contains the character # 538 -- and is otherwise set False. 539 -- 540 -- We need to know right away these aspects of a message, since we will 541 -- test these values before doing the full error scan. 542 -- 543 -- Note that the call has no effect for continuation messages (those whose 544 -- first character is '\'), and all variables are left unchanged, unless 545 -- -gnatdF is set. 546 547 procedure Purge_Messages (From : Source_Ptr; To : Source_Ptr); 548 -- All error messages whose location is in the range From .. To (not 549 -- including the end points) will be deleted from the error listing. 550 551 function Same_Error (M1, M2 : Error_Msg_Id) return Boolean; 552 -- See if two messages have the same text. Returns true if the text of the 553 -- two messages is identical, or if one of them is the same as the other 554 -- with an appended "instance at xxx" tag. 555 556 procedure Set_Msg_Blank; 557 -- Sets a single blank in the message if the preceding character is a 558 -- non-blank character other than a left parenthesis or minus. Has no 559 -- effect if manual quote mode is turned on. 560 561 procedure Set_Msg_Blank_Conditional; 562 -- Sets a single blank in the message if the preceding character is a 563 -- non-blank character other than a left parenthesis or quote. Has no 564 -- effect if manual quote mode is turned on. 565 566 procedure Set_Msg_Char (C : Character); 567 -- Add a single character to the current message. This routine does not 568 -- check for special insertion characters (they are just treated as text 569 -- characters if they occur). 570 571 procedure Set_Msg_Insertion_File_Name; 572 -- Handle file name insertion (left brace insertion character) 573 574 procedure Set_Msg_Insertion_Line_Number (Loc, Flag : Source_Ptr); 575 -- Handle line number insertion (# insertion character). Loc is the 576 -- location to be referenced, and Flag is the location at which the 577 -- flag is posted (used to determine whether to add "in file xxx") 578 579 procedure Set_Msg_Insertion_Name_Literal; 580 581 procedure Set_Msg_Insertion_Name; 582 -- Handle name insertion (% insertion character) 583 584 procedure Set_Msg_Insertion_Reserved_Name; 585 -- Handle insertion of reserved word name (* insertion character) 586 587 procedure Set_Msg_Insertion_Reserved_Word 588 (Text : String; 589 J : in out Integer); 590 -- Handle reserved word insertion (upper case letters). The Text argument 591 -- is the current error message input text, and J is an index which on 592 -- entry points to the first character of the reserved word, and on exit 593 -- points past the last character of the reserved word. Note that RM and 594 -- SPARK are treated specially and not considered to be keywords. 595 596 procedure Set_Msg_Insertion_Run_Time_Name; 597 -- If package System contains a definition for Run_Time_Name (see package 598 -- Targparm for details), then this procedure will insert a message of 599 -- the form (name) into the current error message, with name set in mixed 600 -- case (upper case after any spaces). If no run time name is defined, 601 -- then this routine has no effect). 602 603 procedure Set_Msg_Insertion_Uint; 604 -- Handle Uint insertion (^ insertion character) 605 606 procedure Set_Msg_Int (Line : Int); 607 -- Set the decimal representation of the argument in the error message 608 -- buffer with no leading zeroes output. 609 610 procedure Set_Msg_Name_Buffer; 611 -- Output name from Name_Buffer, with surrounding quotes unless manual 612 -- quotation mode is in effect. 613 614 procedure Set_Msg_Quote; 615 -- Set quote if in normal quote mode, nothing if in manual quote mode 616 617 procedure Set_Msg_Str (Text : String); 618 -- Add a sequence of characters to the current message. This routine does 619 -- not check for special insertion characters (they are just treated as 620 -- text characters if they occur). It does perform the transformation of 621 -- the special strings _xxx (xxx = Pre/Post/Type_Invariant) to xxx'Class. 622 623 procedure Set_Next_Non_Deleted_Msg (E : in out Error_Msg_Id); 624 -- Given a message id, move to next message id, but skip any deleted 625 -- messages, so that this results in E on output being the first non- 626 -- deleted message following the input value of E, or No_Error_Msg if 627 -- the input value of E was either already No_Error_Msg, or was the 628 -- last non-deleted message. 629 630 procedure Set_Specific_Warning_Off 631 (Loc : Source_Ptr; 632 Msg : String; 633 Reason : String_Id; 634 Config : Boolean; 635 Used : Boolean := False); 636 -- This is called in response to the two argument form of pragma Warnings 637 -- where the first argument is OFF, and the second argument is a string 638 -- which identifies a specific warning to be suppressed. The first argument 639 -- is the start of the suppression range, and the second argument is the 640 -- string from the pragma. Loc is the location of the pragma (which is the 641 -- start of the range to suppress). Reason is the reason string from the 642 -- pragma, or the null string if no reason is given. Config is True for the 643 -- configuration pragma case (where there is no requirement for a matching 644 -- OFF pragma). Used is set True to disable the check that the warning 645 -- actually has the effect of suppressing a warning. 646 647 procedure Set_Specific_Warning_On 648 (Loc : Source_Ptr; 649 Msg : String; 650 Err : out Boolean); 651 -- This is called in response to the two argument form of pragma Warnings 652 -- where the first argument is ON, and the second argument is a string 653 -- which identifies a specific warning to be suppressed. The first argument 654 -- is the end of the suppression range, and the second argument is the 655 -- string from the pragma. Err is set to True on return to report the error 656 -- of no matching Warnings Off pragma preceding this one. 657 658 procedure Set_Warnings_Mode_Off (Loc : Source_Ptr; Reason : String_Id); 659 -- Called in response to a pragma Warnings (Off) to record the source 660 -- location from which warnings are to be turned off. Reason is the 661 -- Reason from the pragma, or the null string if none is given. 662 663 procedure Set_Warnings_Mode_On (Loc : Source_Ptr); 664 -- Called in response to a pragma Warnings (On) to record the source 665 -- location from which warnings are to be turned back on. 666 667 function Warnings_Suppressed (Loc : Source_Ptr) return String_Id; 668 -- Determines if given location is covered by a warnings off suppression 669 -- range in the warnings table (or is suppressed by compilation option, 670 -- which generates a warning range for the whole source file). This routine 671 -- only deals with the general ON/OFF case, not specific warnings. The 672 -- returned result is No_String if warnings are not suppressed. If warnings 673 -- are suppressed for the given location, then corresponding Reason 674 -- parameter from the pragma is returned (or the null string if no Reason 675 -- parameter was present). 676 677 function Warning_Specifically_Suppressed 678 (Loc : Source_Ptr; 679 Msg : String_Ptr; 680 Tag : String := "") return String_Id; 681 -- Determines if given message to be posted at given location is suppressed 682 -- by specific ON/OFF Warnings pragmas specifying this particular message. 683 -- If the warning is not suppressed then No_String is returned, otherwise 684 -- the corresponding warning string is returned (or the null string if no 685 -- Warning argument was present in the pragma). Tag is the error message 686 -- tag for the message in question or the null string if there is no tag. 687 -- 688 -- Note: we have a null default for Tag to deal with calls from an old 689 -- branch of gnat2why, which does not know about tags in the calls but 690 -- which uses the latest version of erroutc. 691 692 function Warning_Treated_As_Error (Msg : String) return Boolean; 693 -- Returns True if the warning message Msg matches any of the strings 694 -- given by Warning_As_Error pragmas, as stored in the Warnings_As_Errors 695 -- table. 696 697 type Error_Msg_Proc is 698 access procedure (Msg : String; Flag_Location : Source_Ptr); 699 procedure Validate_Specific_Warnings (Eproc : Error_Msg_Proc); 700 -- Checks that specific warnings are consistent (for non-configuration 701 -- case, properly closed, and used). The argument is a pointer to the 702 -- Error_Msg procedure to be called if any inconsistencies are detected. 703 704end Erroutc; 705