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-2003 Free Software Foundation, Inc. -- 10-- -- 11-- GNAT is free software; you can redistribute it and/or modify it under -- 12-- terms of the GNU General Public License as published by the Free Soft- -- 13-- ware Foundation; either version 2, or (at your option) any later ver- -- 14-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- 17-- for more details. You should have received a copy of the GNU General -- 18-- Public License distributed with GNAT; see file COPYING. If not, write -- 19-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- 20-- MA 02111-1307, USA. -- 21-- -- 22-- GNAT was originally developed by the GNAT team at New York University. -- 23-- Extensive contributions were provided by Ada Core Technologies Inc. -- 24-- -- 25------------------------------------------------------------------------------ 26 27-- This packages contains global variables and routines common to error 28-- reporting packages, including Errout and Prj.Err. 29 30with Hostparm; 31with Table; 32with Types; use Types; 33 34package Erroutc is 35 36 Class_Flag : Boolean := False; 37 -- This flag is set True when outputting a reference to a class-wide 38 -- type, and is used by Add_Class to insert 'Class at the proper point 39 40 Continuation : Boolean := False; 41 -- Indicates if current message is a continuation. Intialized from the 42 -- Msg_Cont parameter in Error_Msg_Internal and then set True if a \ 43 -- insertion character is encountered. 44 45 Flag_Source : Source_File_Index; 46 -- Source file index for source file where error is being posted 47 48 Is_Warning_Msg : Boolean := False; 49 -- Set True to indicate if current message is warning message 50 51 Is_Style_Msg : Boolean := False; 52 -- Set True to indicate if the current message is a style message 53 54 Is_Serious_Error : Boolean := False; 55 -- Set by Set_Msg_Text to indicate if current message is serious error 56 57 Is_Unconditional_Msg : Boolean := False; 58 -- Set by Set_Msg_Text to indicate if current message is unconditional 59 60 Kill_Message : Boolean := False; 61 -- A flag used to kill weird messages (e.g. those containing uninterpreted 62 -- implicit type references) if we have already seen at least one message 63 -- already. The idea is that we hope the weird message is a junk cascaded 64 -- message that should be suppressed. 65 66 Last_Killed : Boolean := False; 67 -- Set True if the most recently posted non-continuation message was 68 -- killed. This is used to determine the processing of any continuation 69 -- messages that follow. 70 71 List_Pragmas_Index : Int := 0; 72 -- Index into List_Pragmas table 73 74 List_Pragmas_Mode : Boolean := False; 75 -- Starts True, gets set False by pragma List (Off), True by List (On) 76 77 Manual_Quote_Mode : Boolean := False; 78 -- Set True in manual quotation mode 79 80 Max_Msg_Length : constant := 80 + 2 * Hostparm.Max_Line_Length; 81 -- Maximum length of error message. The addition of Max_Line_Length 82 -- ensures that two insertion tokens of maximum length can be accomodated. 83 84 Msg_Buffer : String (1 .. Max_Msg_Length); 85 -- Buffer used to prepare error messages 86 87 Msglen : Integer := 0; 88 -- Number of characters currently stored in the message buffer 89 90 Suppress_Message : Boolean; 91 -- A flag used to suppress certain obviously redundant messages (i.e. 92 -- those referring to a node whose type is Any_Type). This suppression 93 -- is effective only if All_Errors_Mode is off. 94 95 Suppress_Instance_Location : Boolean := False; 96 -- Normally, if a # location in a message references a location within 97 -- a generic template, then a note is added giving the location of the 98 -- instantiation. If this variable is set True, then this note is not 99 -- output. This is used for internal processing for the case of an 100 -- illegal instantiation. See Error_Msg routine for further details. 101 102 ---------------------------- 103 -- Message ID Definitions -- 104 ---------------------------- 105 106 type Error_Msg_Id is new Int; 107 -- A type used to represent specific error messages. Used by the clients 108 -- of this package only in the context of the Get_Error_Id and 109 -- Change_Error_Text subprograms. 110 111 No_Error_Msg : constant Error_Msg_Id := 0; 112 -- A constant which is different from any value returned by Get_Error_Id. 113 -- Typically used by a client to indicate absense of a saved Id value. 114 115 Cur_Msg : Error_Msg_Id := No_Error_Msg; 116 -- Id of most recently posted error message 117 118 function Get_Msg_Id return Error_Msg_Id; 119 -- Returns the Id of the message most recently posted using one of the 120 -- Error_Msg routines. 121 122 function Get_Location (E : Error_Msg_Id) return Source_Ptr; 123 -- Returns the flag location of the error message with the given id E. 124 125 ----------------------------------- 126 -- Error Message Data Structures -- 127 ----------------------------------- 128 129 -- The error messages are stored as a linked list of error message objects 130 -- sorted into ascending order by the source location (Sloc). Each object 131 -- records the text of the message and its source location. 132 133 -- The following record type and table are used to represent error 134 -- messages, with one entry in the table being allocated for each message. 135 136 type Error_Msg_Object is record 137 Text : String_Ptr; 138 -- Text of error message, fully expanded with all insertions 139 140 Next : Error_Msg_Id; 141 -- Pointer to next message in error chain 142 143 Sfile : Source_File_Index; 144 -- Source table index of source file. In the case of an error that 145 -- refers to a template, always references the original template 146 -- not an instantiation copy. 147 148 Sptr : Source_Ptr; 149 -- Flag pointer. In the case of an error that refers to a template, 150 -- always references the original template, not an instantiation copy. 151 -- This value is the actual place in the source that the error message 152 -- will be posted. Note that an error placed on an instantiation will 153 -- have Sptr pointing to the instantiation point. 154 155 Optr : Source_Ptr; 156 -- Flag location used in the call to post the error. This is normally 157 -- the same as Sptr, except when an error is posted on a particular 158 -- instantiation of a generic. In such a case, Sptr will point to 159 -- the original source location of the instantiation itself, but 160 -- Optr will point to the template location (more accurately to the 161 -- template copy in the instantiation copy corresponding to the 162 -- instantiation referenced by Sptr). 163 164 Line : Physical_Line_Number; 165 -- Line number for error message 166 167 Col : Column_Number; 168 -- Column number for error message 169 170 Warn : Boolean; 171 -- True if warning message (i.e. insertion character ? appeared) 172 173 Style : Boolean; 174 -- True if style message (starts with "(style)") 175 176 Serious : Boolean; 177 -- True if serious error message (not a warning and no | character) 178 179 Uncond : Boolean; 180 -- True if unconditional message (i.e. insertion character ! appeared) 181 182 Msg_Cont : Boolean; 183 -- This is used for logical messages that are composed of multiple 184 -- individual messages. For messages that are not part of such a 185 -- group, or that are the first message in such a group. Msg_Cont 186 -- is set to False. For subsequent messages in a group, Msg_Cont 187 -- is set to True. This is used to make sure that such a group of 188 -- messages is either suppressed or retained as a group (e.g. in 189 -- the circuit that deletes identical messages). 190 191 Deleted : Boolean; 192 -- If this flag is set, the message is not printed. This is used 193 -- in the circuit for deleting duplicate/redundant error messages. 194 end record; 195 196 package Errors is new Table.Table ( 197 Table_Component_Type => Error_Msg_Object, 198 Table_Index_Type => Error_Msg_Id, 199 Table_Low_Bound => 1, 200 Table_Initial => 200, 201 Table_Increment => 200, 202 Table_Name => "Error"); 203 204 First_Error_Msg : Error_Msg_Id; 205 -- The list of error messages, i.e. the first entry on the list of error 206 -- messages. This is not the same as the physically first entry in the 207 -- error message table, since messages are not always inserted in sequence. 208 209 Last_Error_Msg : Error_Msg_Id; 210 -- The last entry on the list of error messages. Note that this is not 211 -- the same as the physically last entry in the error message table, since 212 -- messages are not always inserted in sequence. 213 214 -------------------------- 215 -- Warning Mode Control -- 216 -------------------------- 217 218 -- Pragma Warnings allows warnings to be turned off for a specified 219 -- region of code, and the following tabl is the data structure used 220 -- to keep track of these regions. 221 222 -- It contains pairs of source locations, the first being the start 223 -- location for a warnings off region, and the second being the end 224 -- location. When a pragma Warnings (Off) is encountered, a new entry 225 -- is established extending from the location of the pragma to the 226 -- end of the current source file. A subsequent pragma Warnings (On) 227 -- adjusts the end point of this entry appropriately. 228 229 -- If all warnings are suppressed by comamnd switch, then there is a 230 -- dummy entry (put there by Errout.Initialize) at the start of the 231 -- table which covers all possible Source_Ptr values. Note that the 232 -- source pointer values in this table always reference the original 233 -- template, not an instantiation copy, in the generic case. 234 235 type Warnings_Entry is record 236 Start : Source_Ptr; 237 Stop : Source_Ptr; 238 end record; 239 240 package Warnings is new Table.Table ( 241 Table_Component_Type => Warnings_Entry, 242 Table_Index_Type => Natural, 243 Table_Low_Bound => 1, 244 Table_Initial => 100, 245 Table_Increment => 200, 246 Table_Name => "Warnings"); 247 248 ----------------- 249 -- Subprograms -- 250 ----------------- 251 252 procedure Add_Class; 253 -- Add 'Class to buffer for class wide type case (Class_Flag set) 254 255 function Buffer_Ends_With (S : String) return Boolean; 256 -- Tests if message buffer ends with given string preceded by a space 257 258 procedure Buffer_Remove (S : String); 259 -- Removes given string from end of buffer if it is present 260 -- at end of buffer, and preceded by a space. 261 262 function Compilation_Errors return Boolean; 263 -- Returns true if errors have been detected, or warnings in -gnatwe 264 -- (treat warnings as errors) mode. 265 266 procedure dmsg (Id : Error_Msg_Id); 267 -- Debugging routine to dump an error message 268 269 procedure Debug_Output (N : Node_Id); 270 -- Called from Error_Msg_N and Error_Msg_NE to generate line of debug 271 -- output giving node number (of node N) if the debug X switch is set. 272 273 procedure Check_Duplicate_Message (M1, M2 : Error_Msg_Id); 274 -- This function is passed the Id values of two error messages. If 275 -- either M1 or M2 is a continuation message, or is already deleted, 276 -- the call is ignored. Otherwise a check is made to see if M1 and M2 277 -- are duplicated or redundant. If so, the message to be deleted and 278 -- all its continuations are marked with the Deleted flag set to True. 279 280 procedure Output_Error_Msgs (E : in out Error_Msg_Id); 281 -- Output source line, error flag, and text of stored error message and 282 -- all subsequent messages for the same line and unit. On return E is 283 -- set to be one higher than the last message output. 284 285 procedure Output_Line_Number (L : Logical_Line_Number); 286 -- Output a line number as six digits (with leading zeroes suppressed), 287 -- followed by a period and a blank (note that this is 8 characters which 288 -- means that tabs in the source line will not get messed up). Line numbers 289 -- that match or are less than the last Source_Reference pragma are listed 290 -- as all blanks, avoiding output of junk line numbers. 291 292 procedure Output_Msg_Text (E : Error_Msg_Id); 293 -- Outputs characters of text in the text of the error message E, excluding 294 -- any final exclamation point. Note that no end of line is output, the 295 -- caller is responsible for adding the end of line. 296 297 procedure Purge_Messages (From : Source_Ptr; To : Source_Ptr); 298 -- All error messages whose location is in the range From .. To (not 299 -- including the end points) will be deleted from the error listing. 300 301 function Same_Error (M1, M2 : Error_Msg_Id) return Boolean; 302 -- See if two messages have the same text. Returns true if the text 303 -- of the two messages is identical, or if one of them is the same 304 -- as the other with an appended "instance at xxx" tag. 305 306 procedure Set_Msg_Blank; 307 -- Sets a single blank in the message if the preceding character is a 308 -- non-blank character other than a left parenthesis. Has no effect if 309 -- manual quote mode is turned on. 310 311 procedure Set_Msg_Blank_Conditional; 312 -- Sets a single blank in the message if the preceding character is a 313 -- non-blank character other than a left parenthesis or quote. Has no 314 -- effect if manual quote mode is turned on. 315 316 procedure Set_Msg_Char (C : Character); 317 -- Add a single character to the current message. This routine does not 318 -- check for special insertion characters (they are just treated as text 319 -- characters if they occur). 320 321 procedure Set_Msg_Insertion_File_Name; 322 -- Handle file name insertion (left brace insertion character) 323 324 procedure Set_Msg_Insertion_Line_Number (Loc, Flag : Source_Ptr); 325 -- Handle line number insertion (# insertion character). Loc is the 326 -- location to be referenced, and Flag is the location at which the 327 -- flag is posted (used to determine whether to add "in file xxx") 328 329 procedure Set_Msg_Insertion_Name; 330 -- Handle name insertion (% insertion character) 331 332 procedure Set_Msg_Insertion_Reserved_Name; 333 -- Handle insertion of reserved word name (* insertion character). 334 335 procedure Set_Msg_Insertion_Reserved_Word 336 (Text : String; 337 J : in out Integer); 338 -- Handle reserved word insertion (upper case letters). The Text argument 339 -- is the current error message input text, and J is an index which on 340 -- entry points to the first character of the reserved word, and on exit 341 -- points past the last character of the reserved word. 342 343 procedure Set_Msg_Insertion_Run_Time_Name; 344 -- If package System contains a definition for Run_Time_Name (see package 345 -- Targparm for details), then this procedure will insert a message of 346 -- the form (name) into the current error message, with name set in mixed 347 -- case (upper case after any spaces). If no run time name is defined, 348 -- then this routine has no effect). 349 350 procedure Set_Msg_Insertion_Uint; 351 -- Handle Uint insertion (^ insertion character) 352 353 procedure Set_Msg_Int (Line : Int); 354 -- Set the decimal representation of the argument in the error message 355 -- buffer with no leading zeroes output. 356 357 procedure Set_Msg_Name_Buffer; 358 -- Output name from Name_Buffer, with surrounding quotes unless manual 359 -- quotation mode is in effect. 360 361 procedure Set_Msg_Quote; 362 -- Set quote if in normal quote mode, nothing if in manual quote mode 363 364 procedure Set_Msg_Str (Text : String); 365 -- Add a sequence of characters to the current message. This routine does 366 -- not check for special insertion characters (they are just treated as 367 -- text characters if they occur). 368 369 procedure Set_Next_Non_Deleted_Msg (E : in out Error_Msg_Id); 370 -- Given a message id, move to next message id, but skip any deleted 371 -- messages, so that this results in E on output being the first non- 372 -- deleted message following the input value of E, or No_Error_Msg if 373 -- the input value of E was either already No_Error_Msg, or was the 374 -- last non-deleted message. 375 376 procedure Set_Warnings_Mode_Off (Loc : Source_Ptr); 377 -- Called in response to a pragma Warnings (Off) to record the source 378 -- location from which warnings are to be turned off. 379 380 procedure Set_Warnings_Mode_On (Loc : Source_Ptr); 381 -- Called in response to a pragma Warnings (On) to record the source 382 -- location from which warnings are to be turned back on. 383 384 procedure Test_Style_Warning_Serious_Msg (Msg : String); 385 -- Sets Is_Warning_Msg true if Msg is a warning message (contains a 386 -- question mark character), and False otherwise. Sets Is_Style_Msg 387 -- true if Msg is a style message (starts with "(style)"). Sets 388 -- Is_Serious_Error True unless the message is a warning or style 389 -- message or contains the character | indicating a non-serious 390 -- error message. Note that the call has no effect for continuation 391 -- messages (those whose first character is \). 392 393 function Warnings_Suppressed (Loc : Source_Ptr) return Boolean; 394 -- Determines if given location is covered by a warnings off suppression 395 -- range in the warnings table (or is suppressed by compilation option, 396 -- which generates a warning range for the whole source file). 397 398end Erroutc; 399