1------------------------------------------------------------------------------ 2-- -- 3-- GPR PROJECT MANAGER -- 4-- -- 5-- Copyright (C) 1992-2015, Free Software Foundation, Inc. -- 6-- -- 7-- This library is free software; you can redistribute it and/or modify it -- 8-- under terms of the GNU General Public License as published by the Free -- 9-- Software Foundation; either version 3, or (at your option) any later -- 10-- version. This library is distributed in the hope that it will be useful, -- 11-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 12-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 13-- -- 14-- As a special exception under Section 7 of GPL version 3, you are granted -- 15-- additional permissions described in the GCC Runtime Library Exception, -- 16-- version 3.1, as published by the Free Software Foundation. -- 17-- -- 18-- You should have received a copy of the GNU General Public License and -- 19-- a copy of the GCC Runtime Library Exception along with this program; -- 20-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 21-- <http://www.gnu.org/licenses/>. -- 22-- -- 23------------------------------------------------------------------------------ 24 25-- This packages contains global variables and routines common to error 26-- reporting packages, including Errout and Prj.Err. 27 28with GNAT.Table; 29 30with GPR.Osint; use GPR.Osint; 31 32package GPR.Erroutc is 33 34 Continuation : Boolean := False; 35 -- Indicates if current message is a continuation. Initialized from the 36 -- Msg_Cont parameter in Error_Msg_Internal and then set True if a \ 37 -- insertion character is encountered. 38 39 Has_Double_Exclam : Boolean := False; 40 -- Set true to indicate that the current message contains the insertion 41 -- sequence !! (force warnings even in non-main unit source files). 42 43 Is_Serious_Error : Boolean := False; 44 -- Set True for a serious error (i.e. any message that is not a warning 45 -- or style message, and that does not contain a | insertion character). 46 47 Is_Unconditional_Msg : Boolean := False; 48 -- Set True to indicate that the current message contains the insertion 49 -- character ! and is thus to be treated as an unconditional message. 50 51 Is_Warning_Msg : Boolean := False; 52 -- Set True to indicate if current message is warning message (contains ? 53 -- or contains < and Error_Msg_Warn is True. 54 55 Is_Info_Msg : Boolean := False; 56 -- Set True to indicate that the current message starts with the characters 57 -- "info: " and is to be treated as an information message. This string 58 -- will be prepended to the message and all its continuations. 59 60 Warning_Msg_Char : Character; 61 -- Warning character, valid only if Is_Warning_Msg is True 62 -- ' ' -- ? or < appeared on its own in message 63 -- '?' -- ?? or << appeared in message 64 -- 'x' -- ?x? or <x< appeared in message (x = a .. z) 65 -- 'X' -- ?X? or <X< appeared in message (X = A .. Z) 66 -- '*' -- ?*? or <*< appeared in message 67 -- '$' -- ?$? or <$< appeared in message 68 -- In the case of the < sequences, this is set only if the message is 69 -- actually a warning, i.e. if Error_Msg_Warn is True 70 71 Kill_Message : Boolean := False; 72 -- A flag used to kill weird messages (e.g. those containing uninterpreted 73 -- implicit type references) if we have already seen at least one message 74 -- already. The idea is that we hope the weird message is a junk cascaded 75 -- message that should be suppressed. 76 77 Last_Killed : Boolean := False; 78 -- Set True if the most recently posted non-continuation message was 79 -- killed. This is used to determine the processing of any continuation 80 -- messages that follow. 81 82 Manual_Quote_Mode : Boolean := False; 83 -- Set True in manual quotation mode 84 85 Max_Msg_Length : constant := 1024 + 2 * Int (Column_Number'Last); 86 -- Maximum length of error message. The addition of 2 * Column_Number'Last 87 -- ensures that two insertion tokens of maximum length can be accommodated. 88 -- The value of 1024 is an arbitrary value that should be more than long 89 -- enough to accommodate any reasonable message (and for that matter, some 90 -- pretty unreasonable messages). 91 92 Msg_Buffer : String (1 .. Max_Msg_Length); 93 -- Buffer used to prepare error messages 94 95 Msglen : Integer := 0; 96 -- Number of characters currently stored in the message buffer 97 98 Suppress_Message : Boolean; 99 -- A flag used to suppress certain obviously redundant messages (i.e. 100 -- those referring to a node whose type is Any_Type). This suppression 101 -- is effective only if All_Errors_Mode is off. 102 103 ---------------------------- 104 -- Message ID Definitions -- 105 ---------------------------- 106 107 type Error_Msg_Id is new Int; 108 -- A type used to represent specific error messages. Used by the clients 109 -- of this package only in the context of the Get_Error_Id and 110 -- Change_Error_Text subprograms. 111 112 No_Error_Msg : constant Error_Msg_Id := 0; 113 -- A constant which is different from any value returned by Get_Error_Id. 114 -- Typically used by a client to indicate absence of a saved Id value. 115 116 Cur_Msg : Error_Msg_Id := No_Error_Msg; 117 -- Id of most recently posted error message 118 119 function Get_Msg_Id return Error_Msg_Id; 120 -- Returns the Id of the message most recently posted using one of the 121 -- Error_Msg routines. 122 123 function Get_Location (E : Error_Msg_Id) return Source_Ptr; 124 -- Returns the flag location of the error message with the given id E 125 126 ----------------------------------- 127 -- Error Message Data Structures -- 128 ----------------------------------- 129 130 -- The error messages are stored as a linked list of error message objects 131 -- sorted into ascending order by the source location (Sloc). Each object 132 -- records the text of the message and its source location. 133 134 -- The following record type and table are used to represent error 135 -- messages, with one entry in the table being allocated for each message. 136 137 type Error_Msg_Object is record 138 Text : String_Access; 139 -- Text of error message, fully expanded with all insertions 140 141 Next : Error_Msg_Id; 142 -- Pointer to next message in error chain. A value of No_Error_Msg 143 -- indicates the end of the chain. 144 145 Prev : Error_Msg_Id; 146 -- Pointer to previous message in error chain. Only set during the 147 -- Finalize procedure. A value of No_Error_Msg indicates the first 148 -- message in the chain. 149 150 Sfile : Source_File_Index; 151 -- Source table index of source file. In the case of an error that 152 -- refers to a template, always references the original template 153 -- not an instantiation copy. 154 155 Sptr : Source_Ptr; 156 -- Flag pointer. In the case of an error that refers to a template, 157 -- always references the original template, not an instantiation copy. 158 -- This value is the actual place in the source that the error message 159 -- will be posted. Note that an error placed on an instantiation will 160 -- have Sptr pointing to the instantiation point. 161 162 Optr : Source_Ptr; 163 -- Flag location used in the call to post the error. This is normally 164 -- the same as Sptr, except when an error is posted on a particular 165 -- instantiation of a generic. In such a case, Sptr will point to 166 -- the original source location of the instantiation itself, but 167 -- Optr will point to the template location (more accurately to the 168 -- template copy in the instantiation copy corresponding to the 169 -- instantiation referenced by Sptr). 170 171 Line : Line_Number; 172 -- Line number for error message 173 174 Col : Column_Number; 175 -- Column number for error message 176 177 Warn : Boolean; 178 -- True if warning message 179 180 Info : Boolean; 181 -- True if info message 182 183 Warn_Err : Boolean; 184 -- True if this is a warning message which is to be treated as an error 185 -- as a result of a match with a Warning_As_Error pragma. 186 187 Warn_Chr : Character; 188 -- Warning character (note: set even if Warning_Doc_Switch is False) 189 -- ' ' -- ? or < appeared on its own in message 190 -- '?' -- ?? or << appeared in message 191 -- 'x' -- ?x? or <x< appeared in message (x = a .. z) 192 -- 'X' -- ?X? or <X< appeared in message (X = A .. Z) 193 -- '*' -- ?*? or <*< appeared in message 194 -- '$' -- ?$? or <$< appeared in message 195 -- In the case of the < sequences, this is set only if the message is 196 -- actually a warning, i.e. if Error_Msg_Warn is True 197 198 Serious : Boolean; 199 -- True if serious error message (not a warning and no | character) 200 201 Uncond : Boolean; 202 -- True if unconditional message (i.e. insertion character ! appeared) 203 204 Msg_Cont : Boolean; 205 -- This is used for logical messages that are composed of multiple 206 -- individual messages. For messages that are not part of such a 207 -- group, or that are the first message in such a group. Msg_Cont 208 -- is set to False. For subsequent messages in a group, Msg_Cont 209 -- is set to True. This is used to make sure that such a group of 210 -- messages is either suppressed or retained as a group (e.g. in 211 -- the circuit that deletes identical messages). 212 213 Deleted : Boolean; 214 -- If this flag is set, the message is not printed. This is used 215 -- in the circuit for deleting duplicate/redundant error messages. 216 end record; 217 218 package Errors is new GNAT.Table ( 219 Table_Component_Type => Error_Msg_Object, 220 Table_Index_Type => Error_Msg_Id, 221 Table_Low_Bound => 1, 222 Table_Initial => 200, 223 Table_Increment => 200); 224 225 First_Error_Msg : Error_Msg_Id; 226 -- The list of error messages, i.e. the first entry on the list of error 227 -- messages. This is not the same as the physically first entry in the 228 -- error message table, since messages are not always inserted in sequence. 229 230 Last_Error_Msg : Error_Msg_Id; 231 -- The last entry on the list of error messages. Note: this is not the same 232 -- as the physically last entry in the error message table, since messages 233 -- are not always inserted in sequence. 234 235 Error_Msg_Name_1 : Name_Id := No_Name; 236 Error_Msg_Name_2 : Name_Id := No_Name; 237 238 Error_Msg_File_1 : File_Name_Type := No_File; 239 Error_Msg_File_2 : File_Name_Type := No_File; 240 241 Error_Msg_Warn : Boolean := False; 242 243 Error_Msg_String : String (1 .. 4096); 244 Error_Msg_Strlen : Natural; 245 -- Used if current message contains a ~ insertion character to indicate 246 -- insertion of the string Error_Msg_String (1 .. Error_Msg_Strlen). 247 248 -------------------------- 249 -- Warning Mode Control -- 250 -------------------------- 251 252 -- Pragma Warnings allows warnings to be turned off for a specified region 253 -- of code, and the following tables are the data structures used to keep 254 -- track of these regions. 255 256 -- The first table is used for the basic command line control, and for the 257 -- forms of Warning with a single ON or OFF parameter. 258 259 -- It contains pairs of source locations, the first being the start 260 -- location for a warnings off region, and the second being the end 261 -- location. When a pragma Warnings (Off) is encountered, a new entry is 262 -- established extending from the location of the pragma to the end of the 263 -- current source file. A subsequent pragma Warnings (On) adjusts the end 264 -- point of this entry appropriately. 265 266 -- If all warnings are suppressed by command switch, then there is a dummy 267 -- entry (put there by Errout.Initialize) at the start of the table which 268 -- covers all possible Source_Ptr values. Note that the source pointer 269 -- values in this table always reference the original template, not an 270 -- instantiation copy, in the generic case. 271 272 -- Reason is the reason from the pragma Warnings (Off,..) or the null 273 -- string if no reason parameter is given. 274 275 type Warnings_Entry is record 276 Start : Source_Ptr; 277 Stop : Source_Ptr; 278 Reason : Name_Id; 279 end record; 280 281 package Warnings is new GNAT.Table ( 282 Table_Component_Type => Warnings_Entry, 283 Table_Index_Type => Natural, 284 Table_Low_Bound => 1, 285 Table_Initial => 100, 286 Table_Increment => 200); 287 288 ----------------- 289 -- Subprograms -- 290 ----------------- 291 292 function Compilation_Errors return Boolean; 293 -- Returns true if errors have been detected, or warnings in -gnatwe 294 -- (treat warnings as errors) mode. 295 296 procedure Check_Duplicate_Message (M1, M2 : Error_Msg_Id); 297 -- This function is passed the Id values of two error messages. If either 298 -- M1 or M2 is a continuation message, or is already deleted, the call is 299 -- ignored. Otherwise a check is made to see if M1 and M2 are duplicated or 300 -- redundant. If so, the message to be deleted and all its continuations 301 -- are marked with the Deleted flag set to True. 302 303 function Is_Start_Of_Wide_Char 304 (S : Source_Buffer_Ptr; 305 P : Source_Ptr) return Boolean; 306 -- Determines if S (P) is the start of a wide character sequence 307 308 procedure Output_Error_Msgs (E : in out Error_Msg_Id); 309 -- Output source line, error flag, and text of stored error message and all 310 -- subsequent messages for the same line and unit. On return E is set to be 311 -- one higher than the last message output. 312 313 procedure Output_Line_Number (L : Line_Number); 314 -- Output a line number as six digits (with leading zeroes suppressed), 315 -- followed by a period and a blank (note that this is 8 characters which 316 -- means that tabs in the source line will not get messed up). Line numbers 317 -- that match or are less than the last Source_Reference pragma are listed 318 -- as all blanks, avoiding output of junk line numbers. 319 320 procedure Output_Msg_Text (E : Error_Msg_Id); 321 -- Outputs characters of text in the text of the error message E. Note that 322 -- no end of line is output, the caller is responsible for adding the end 323 -- of line. If Error_Msg_Line_Length is non-zero, this is the routine that 324 -- splits the line generating multiple lines of output, and in this case 325 -- the last line has no terminating end of line character. 326 327 procedure Set_Msg_Char (C : Character); 328 -- Add a single character to the current message. This routine does not 329 -- check for special insertion characters (they are just treated as text 330 -- characters if they occur). 331 332 procedure Set_Msg_Insertion_File_Name; 333 -- Handle file name insertion (left brace insertion character) 334 335 procedure Set_Msg_Insertion_Name_Literal; 336 337 procedure Set_Msg_Insertion_Name; 338 -- Handle name insertion (% insertion character) 339 340 procedure Set_Msg_Insertion_Reserved_Name; 341 -- Handle insertion of reserved word name (* insertion character) 342 343 procedure Set_Msg_Insertion_Reserved_Word 344 (Text : String; 345 J : in out Integer); 346 -- Handle reserved word insertion (upper case letters). The Text argument 347 -- is the current error message input text, and J is an index which on 348 -- entry points to the first character of the reserved word, and on exit 349 -- points past the last character of the reserved word. Note that RM and 350 -- SPARK are treated specially and not considered to be keywords. 351 352 procedure Set_Msg_Str (Text : String); 353 -- Add a sequence of characters to the current message. This routine does 354 -- not check for special insertion characters (they are just treated as 355 -- text characters if they occur). It does perform the transformation of 356 -- the special strings _xxx (xxx = Pre/Post/Type_Invariant) to xxx'Class. 357 358end GPR.Erroutc; 359