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-2012, 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 Is_Warning_Msg : Boolean := False; 51 -- Set True to indicate if current message is warning message 52 53 Warning_Msg_Char : Character; 54 -- Warning character, valid only if Is_Warning_Msg is True 55 -- ' ' -- ? appeared on its own in message 56 -- '?' -- ?? appeared in message 57 -- 'x' -- ?x? appeared in message 58 -- 'X' -- ?x? appeared in message (X is upper case of x) 59 60 Is_Style_Msg : Boolean := False; 61 -- Set True to indicate if the current message is a style message 62 -- (i.e. a message whose text starts with the characters "(style)"). 63 64 Is_Serious_Error : Boolean := False; 65 -- Set by Set_Msg_Text to indicate if current message is serious error 66 67 Is_Unconditional_Msg : Boolean := False; 68 -- Set by Set_Msg_Text to indicate if current message is unconditional 69 70 Kill_Message : Boolean := False; 71 -- A flag used to kill weird messages (e.g. those containing uninterpreted 72 -- implicit type references) if we have already seen at least one message 73 -- already. The idea is that we hope the weird message is a junk cascaded 74 -- message that should be suppressed. 75 76 Last_Killed : Boolean := False; 77 -- Set True if the most recently posted non-continuation message was 78 -- killed. This is used to determine the processing of any continuation 79 -- messages that follow. 80 81 List_Pragmas_Index : Int := 0; 82 -- Index into List_Pragmas table 83 84 List_Pragmas_Mode : Boolean := False; 85 -- Starts True, gets set False by pragma List (Off), True by List (On) 86 87 Manual_Quote_Mode : Boolean := False; 88 -- Set True in manual quotation mode 89 90 Max_Msg_Length : constant := 1024 + 2 * Int (Column_Number'Last); 91 -- Maximum length of error message. The addition of 2 * Column_Number'Last 92 -- ensures that two insertion tokens of maximum length can be accommodated. 93 -- The value of 1024 is an arbitrary value that should be more than long 94 -- enough to accommodate any reasonable message (and for that matter, some 95 -- pretty unreasonable messages!) 96 97 Msg_Buffer : String (1 .. Max_Msg_Length); 98 -- Buffer used to prepare error messages 99 100 Msglen : Integer := 0; 101 -- Number of characters currently stored in the message buffer 102 103 Suppress_Message : Boolean; 104 -- A flag used to suppress certain obviously redundant messages (i.e. 105 -- those referring to a node whose type is Any_Type). This suppression 106 -- is effective only if All_Errors_Mode is off. 107 108 Suppress_Instance_Location : Boolean := False; 109 -- Normally, if a # location in a message references a location within 110 -- a generic template, then a note is added giving the location of the 111 -- instantiation. If this variable is set True, then this note is not 112 -- output. This is used for internal processing for the case of an 113 -- illegal instantiation. See Error_Msg routine for further details. 114 115 ---------------------------- 116 -- Message ID Definitions -- 117 ---------------------------- 118 119 type Error_Msg_Id is new Int; 120 -- A type used to represent specific error messages. Used by the clients 121 -- of this package only in the context of the Get_Error_Id and 122 -- Change_Error_Text subprograms. 123 124 No_Error_Msg : constant Error_Msg_Id := 0; 125 -- A constant which is different from any value returned by Get_Error_Id. 126 -- Typically used by a client to indicate absence of a saved Id value. 127 128 Cur_Msg : Error_Msg_Id := No_Error_Msg; 129 -- Id of most recently posted error message 130 131 function Get_Msg_Id return Error_Msg_Id; 132 -- Returns the Id of the message most recently posted using one of the 133 -- Error_Msg routines. 134 135 function Get_Location (E : Error_Msg_Id) return Source_Ptr; 136 -- Returns the flag location of the error message with the given id E 137 138 ----------------------------------- 139 -- Error Message Data Structures -- 140 ----------------------------------- 141 142 -- The error messages are stored as a linked list of error message objects 143 -- sorted into ascending order by the source location (Sloc). Each object 144 -- records the text of the message and its source location. 145 146 -- The following record type and table are used to represent error 147 -- messages, with one entry in the table being allocated for each message. 148 149 type Error_Msg_Object is record 150 Text : String_Ptr; 151 -- Text of error message, fully expanded with all insertions 152 153 Next : Error_Msg_Id; 154 -- Pointer to next message in error chain. A value of No_Error_Msg 155 -- indicates the end of the chain. 156 157 Prev : Error_Msg_Id; 158 -- Pointer to previous message in error chain. Only set during the 159 -- Finalize procedure. A value of No_Error_Msg indicates the first 160 -- message in the chain. 161 162 Sfile : Source_File_Index; 163 -- Source table index of source file. In the case of an error that 164 -- refers to a template, always references the original template 165 -- not an instantiation copy. 166 167 Sptr : Source_Ptr; 168 -- Flag pointer. In the case of an error that refers to a template, 169 -- always references the original template, not an instantiation copy. 170 -- This value is the actual place in the source that the error message 171 -- will be posted. Note that an error placed on an instantiation will 172 -- have Sptr pointing to the instantiation point. 173 174 Optr : Source_Ptr; 175 -- Flag location used in the call to post the error. This is normally 176 -- the same as Sptr, except when an error is posted on a particular 177 -- instantiation of a generic. In such a case, Sptr will point to 178 -- the original source location of the instantiation itself, but 179 -- Optr will point to the template location (more accurately to the 180 -- template copy in the instantiation copy corresponding to the 181 -- instantiation referenced by Sptr). 182 183 Line : Physical_Line_Number; 184 -- Line number for error message 185 186 Col : Column_Number; 187 -- Column number for error message 188 189 Warn : Boolean; 190 -- True if warning message (i.e. insertion character ? appeared) 191 192 Warn_Chr : Character; 193 -- Warning character, valid only if Warn is True 194 -- ' ' -- ? appeared on its own in message 195 -- '?' -- ?? appeared in message 196 -- 'x' -- ?x? appeared in message 197 -- 'X' -- ?x? appeared in message (X is upper case of x) 198 199 Style : Boolean; 200 -- True if style message (starts with "(style)") 201 202 Serious : Boolean; 203 -- True if serious error message (not a warning and no | character) 204 205 Uncond : Boolean; 206 -- True if unconditional message (i.e. insertion character ! appeared) 207 208 Msg_Cont : Boolean; 209 -- This is used for logical messages that are composed of multiple 210 -- individual messages. For messages that are not part of such a 211 -- group, or that are the first message in such a group. Msg_Cont 212 -- is set to False. For subsequent messages in a group, Msg_Cont 213 -- is set to True. This is used to make sure that such a group of 214 -- messages is either suppressed or retained as a group (e.g. in 215 -- the circuit that deletes identical messages). 216 217 Deleted : Boolean; 218 -- If this flag is set, the message is not printed. This is used 219 -- in the circuit for deleting duplicate/redundant error messages. 220 end record; 221 222 package Errors is new Table.Table ( 223 Table_Component_Type => Error_Msg_Object, 224 Table_Index_Type => Error_Msg_Id, 225 Table_Low_Bound => 1, 226 Table_Initial => 200, 227 Table_Increment => 200, 228 Table_Name => "Error"); 229 230 First_Error_Msg : Error_Msg_Id; 231 -- The list of error messages, i.e. the first entry on the list of error 232 -- messages. This is not the same as the physically first entry in the 233 -- error message table, since messages are not always inserted in sequence. 234 235 Last_Error_Msg : Error_Msg_Id; 236 -- The last entry on the list of error messages. Note: this is not the same 237 -- as the physically last entry in the error message table, since messages 238 -- are not always inserted in sequence. 239 240 -------------------------- 241 -- Warning Mode Control -- 242 -------------------------- 243 244 -- Pragma Warnings allows warnings to be turned off for a specified region 245 -- of code, and the following tables are the data structures used to keep 246 -- track of these regions. 247 248 -- The first table is used for the basic command line control, and for the 249 -- forms of Warning with a single ON or OFF parameter. 250 251 -- It contains pairs of source locations, the first being the start 252 -- location for a warnings off region, and the second being the end 253 -- location. When a pragma Warnings (Off) is encountered, a new entry is 254 -- established extending from the location of the pragma to the end of the 255 -- current source file. A subsequent pragma Warnings (On) adjusts the end 256 -- point of this entry appropriately. 257 258 -- If all warnings are suppressed by command switch, then there is a dummy 259 -- entry (put there by Errout.Initialize) at the start of the table which 260 -- covers all possible Source_Ptr values. Note that the source pointer 261 -- values in this table always reference the original template, not an 262 -- instantiation copy, in the generic case. 263 264 type Warnings_Entry is record 265 Start : Source_Ptr; 266 Stop : Source_Ptr; 267 end record; 268 269 package Warnings is new Table.Table ( 270 Table_Component_Type => Warnings_Entry, 271 Table_Index_Type => Natural, 272 Table_Low_Bound => 1, 273 Table_Initial => 100, 274 Table_Increment => 200, 275 Table_Name => "Warnings"); 276 277 -- The second table is used for the specific forms of the pragma, where 278 -- the first argument is ON or OFF, and the second parameter is a string 279 -- which is the entire message to suppress, or a prefix of it. 280 281 type Specific_Warning_Entry is record 282 Start : Source_Ptr; 283 Stop : Source_Ptr; 284 -- Starting and ending source pointers for the range. These are always 285 -- from the same source file. 286 287 Msg : String_Ptr; 288 -- Message from pragma Warnings (Off, string) 289 290 Open : Boolean; 291 -- Set to True if OFF has been encountered with no matching ON 292 293 Used : Boolean; 294 -- Set to True if entry has been used to suppress a warning 295 296 Config : Boolean; 297 -- True if pragma is configuration pragma (in which case no matching Off 298 -- pragma is required, and it is not required that a specific warning be 299 -- suppressed). 300 end record; 301 302 package Specific_Warnings is new Table.Table ( 303 Table_Component_Type => Specific_Warning_Entry, 304 Table_Index_Type => Natural, 305 Table_Low_Bound => 1, 306 Table_Initial => 100, 307 Table_Increment => 200, 308 Table_Name => "Specific_Warnings"); 309 310 -- Note on handling configuration case versus specific case. A complication 311 -- arises from this example: 312 313 -- pragma Warnings (Off, "not referenced*"); 314 -- procedure Mumble (X : Integer) is 315 -- pragma Warnings (On, "not referenced*"); 316 -- begin 317 -- null; 318 -- end Mumble; 319 320 -- The trouble is that the first pragma is technically a configuration 321 -- pragma, and yet it is clearly being used in the context of thinking of 322 -- it as a specific case. To deal with this, what we do is that the On 323 -- entry can match a configuration pragma from the same file, and if we 324 -- find such an On entry, we cancel the indication of it being the 325 -- configuration case. This seems to handle all cases we run into ok. 326 327 ----------------- 328 -- Subprograms -- 329 ----------------- 330 331 procedure Add_Class; 332 -- Add 'Class to buffer for class wide type case (Class_Flag set) 333 334 function Buffer_Ends_With (S : String) return Boolean; 335 -- Tests if message buffer ends with given string preceded by a space 336 337 procedure Buffer_Remove (S : String); 338 -- Removes given string from end of buffer if it is present 339 -- at end of buffer, and preceded by a space. 340 341 function Compilation_Errors return Boolean; 342 -- Returns true if errors have been detected, or warnings in -gnatwe 343 -- (treat warnings as errors) mode. 344 345 procedure dmsg (Id : Error_Msg_Id); 346 -- Debugging routine to dump an error message 347 348 procedure Debug_Output (N : Node_Id); 349 -- Called from Error_Msg_N and Error_Msg_NE to generate line of debug 350 -- output giving node number (of node N) if the debug X switch is set. 351 352 procedure Check_Duplicate_Message (M1, M2 : Error_Msg_Id); 353 -- This function is passed the Id values of two error messages. If either 354 -- M1 or M2 is a continuation message, or is already deleted, the call is 355 -- ignored. Otherwise a check is made to see if M1 and M2 are duplicated or 356 -- redundant. If so, the message to be deleted and all its continuations 357 -- are marked with the Deleted flag set to True. 358 359 procedure Output_Error_Msgs (E : in out Error_Msg_Id); 360 -- Output source line, error flag, and text of stored error message and all 361 -- subsequent messages for the same line and unit. On return E is set to be 362 -- one higher than the last message output. 363 364 procedure Output_Line_Number (L : Logical_Line_Number); 365 -- Output a line number as six digits (with leading zeroes suppressed), 366 -- followed by a period and a blank (note that this is 8 characters which 367 -- means that tabs in the source line will not get messed up). Line numbers 368 -- that match or are less than the last Source_Reference pragma are listed 369 -- as all blanks, avoiding output of junk line numbers. 370 371 procedure Output_Msg_Text (E : Error_Msg_Id); 372 -- Outputs characters of text in the text of the error message E. Note that 373 -- no end of line is output, the caller is responsible for adding the end 374 -- of line. If Error_Msg_Line_Length is non-zero, this is the routine that 375 -- splits the line generating multiple lines of output, and in this case 376 -- the last line has no terminating end of line character. 377 378 procedure Purge_Messages (From : Source_Ptr; To : Source_Ptr); 379 -- All error messages whose location is in the range From .. To (not 380 -- including the end points) will be deleted from the error listing. 381 382 function Same_Error (M1, M2 : Error_Msg_Id) return Boolean; 383 -- See if two messages have the same text. Returns true if the text of the 384 -- two messages is identical, or if one of them is the same as the other 385 -- with an appended "instance at xxx" tag. 386 387 procedure Set_Msg_Blank; 388 -- Sets a single blank in the message if the preceding character is a 389 -- non-blank character other than a left parenthesis or minus. Has no 390 -- effect if manual quote mode is turned on. 391 392 procedure Set_Msg_Blank_Conditional; 393 -- Sets a single blank in the message if the preceding character is a 394 -- non-blank character other than a left parenthesis or quote. Has no 395 -- effect if manual quote mode is turned on. 396 397 procedure Set_Msg_Char (C : Character); 398 -- Add a single character to the current message. This routine does not 399 -- check for special insertion characters (they are just treated as text 400 -- characters if they occur). 401 402 procedure Set_Msg_Insertion_File_Name; 403 -- Handle file name insertion (left brace insertion character) 404 405 procedure Set_Msg_Insertion_Line_Number (Loc, Flag : Source_Ptr); 406 -- Handle line number insertion (# insertion character). Loc is the 407 -- location to be referenced, and Flag is the location at which the 408 -- flag is posted (used to determine whether to add "in file xxx") 409 410 procedure Set_Msg_Insertion_Name_Literal; 411 412 procedure Set_Msg_Insertion_Name; 413 -- Handle name insertion (% insertion character) 414 415 procedure Set_Msg_Insertion_Reserved_Name; 416 -- Handle insertion of reserved word name (* insertion character) 417 418 procedure Set_Msg_Insertion_Reserved_Word 419 (Text : String; 420 J : in out Integer); 421 -- Handle reserved word insertion (upper case letters). The Text argument 422 -- is the current error message input text, and J is an index which on 423 -- entry points to the first character of the reserved word, and on exit 424 -- points past the last character of the reserved word. 425 426 procedure Set_Msg_Insertion_Run_Time_Name; 427 -- If package System contains a definition for Run_Time_Name (see package 428 -- Targparm for details), then this procedure will insert a message of 429 -- the form (name) into the current error message, with name set in mixed 430 -- case (upper case after any spaces). If no run time name is defined, 431 -- then this routine has no effect). 432 433 procedure Set_Msg_Insertion_Uint; 434 -- Handle Uint insertion (^ insertion character) 435 436 procedure Set_Msg_Int (Line : Int); 437 -- Set the decimal representation of the argument in the error message 438 -- buffer with no leading zeroes output. 439 440 procedure Set_Msg_Name_Buffer; 441 -- Output name from Name_Buffer, with surrounding quotes unless manual 442 -- quotation mode is in effect. 443 444 procedure Set_Msg_Quote; 445 -- Set quote if in normal quote mode, nothing if in manual quote mode 446 447 procedure Set_Msg_Str (Text : String); 448 -- Add a sequence of characters to the current message. This routine does 449 -- not check for special insertion characters (they are just treated as 450 -- text characters if they occur). 451 452 procedure Set_Next_Non_Deleted_Msg (E : in out Error_Msg_Id); 453 -- Given a message id, move to next message id, but skip any deleted 454 -- messages, so that this results in E on output being the first non- 455 -- deleted message following the input value of E, or No_Error_Msg if 456 -- the input value of E was either already No_Error_Msg, or was the 457 -- last non-deleted message. 458 459 procedure Set_Specific_Warning_Off 460 (Loc : Source_Ptr; 461 Msg : String; 462 Config : Boolean; 463 Used : Boolean := False); 464 -- This is called in response to the two argument form of pragma Warnings 465 -- where the first argument is OFF, and the second argument is a string 466 -- which identifies a specific warning to be suppressed. The first argument 467 -- is the start of the suppression range, and the second argument is the 468 -- string from the pragma. Loc is the location of the pragma (which is the 469 -- start of the range to suppress). Config is True for the configuration 470 -- pragma case (where there is no requirement for a matching OFF pragma). 471 -- Used is set True to disable the check that the warning actually has 472 -- has the effect of suppressing a warning. 473 474 procedure Set_Specific_Warning_On 475 (Loc : Source_Ptr; 476 Msg : String; 477 Err : out Boolean); 478 -- This is called in response to the two argument form of pragma Warnings 479 -- where the first argument is ON, and the second argument is a string 480 -- which identifies a specific warning to be suppressed. The first argument 481 -- is the end of the suppression range, and the second argument is the 482 -- string from the pragma. Err is set to True on return to report the error 483 -- of no matching Warnings Off pragma preceding this one. 484 485 procedure Set_Warnings_Mode_Off (Loc : Source_Ptr); 486 -- Called in response to a pragma Warnings (Off) to record the source 487 -- location from which warnings are to be turned off. 488 489 procedure Set_Warnings_Mode_On (Loc : Source_Ptr); 490 -- Called in response to a pragma Warnings (On) to record the source 491 -- location from which warnings are to be turned back on. 492 493 procedure Test_Style_Warning_Serious_Msg (Msg : String); 494 -- Sets Is_Warning_Msg true if Msg is a warning message (contains a 495 -- question mark character), and False otherwise. Is_Style_Msg is set true 496 -- if Msg is a style message (starts with "(style)". Sets Is_Serious_Error 497 -- True unless the message is a warning or style/info message or contains 498 -- the character | indicating a non-serious error message. Note that the 499 -- call has no effect for continuation messages (those whose first 500 -- character is '\'). 501 502 function Warnings_Suppressed (Loc : Source_Ptr) return Boolean; 503 -- Determines if given location is covered by a warnings off suppression 504 -- range in the warnings table (or is suppressed by compilation option, 505 -- which generates a warning range for the whole source file). This routine 506 -- only deals with the general ON/OFF case, not specific warnings. True 507 -- is also returned if warnings are globally suppressed. 508 509 function Warning_Specifically_Suppressed 510 (Loc : Source_Ptr; 511 Msg : String_Ptr) return Boolean; 512 -- Determines if given message to be posted at given location is suppressed 513 -- by specific ON/OFF Warnings pragmas specifying this particular message. 514 515 type Error_Msg_Proc is 516 access procedure (Msg : String; Flag_Location : Source_Ptr); 517 procedure Validate_Specific_Warnings (Eproc : Error_Msg_Proc); 518 -- Checks that specific warnings are consistent (for non-configuration 519 -- case, properly closed, and used). The argument is a pointer to the 520 -- Error_Msg procedure to be called if any inconsistencies are detected. 521 522end Erroutc; 523