-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
--- ware Foundation; either version 2, or (at your option) any later ver- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
--- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, USA. --
+-- Public License distributed with GNAT; see file COPYING3. If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- This packages contains global variables and routines common to error
-- reporting packages, including Errout and Prj.Err.
-with Hostparm;
with Table;
-with Types; use Types;
+with Types; use Types;
package Erroutc is
-- type, and is used by Add_Class to insert 'Class at the proper point
Continuation : Boolean := False;
- -- Indicates if current message is a continuation. Intialized from the
+ -- Indicates if current message is a continuation. Initialized from the
-- Msg_Cont parameter in Error_Msg_Internal and then set True if a \
-- insertion character is encountered.
+ Continuation_New_Line : Boolean := False;
+ -- Indicates if current message was a continuation line marked with \\ to
+ -- force a new line. Set True if \\ encountered.
+
Flag_Source : Source_File_Index;
-- Source file index for source file where error is being posted
Is_Style_Msg : Boolean := False;
-- Set True to indicate if the current message is a style message
+ -- (i.e. a message whose text starts with the characters "(style)").
Is_Serious_Error : Boolean := False;
-- Set by Set_Msg_Text to indicate if current message is serious error
Manual_Quote_Mode : Boolean := False;
-- Set True in manual quotation mode
- Max_Msg_Length : constant := 256 + 2 * Hostparm.Max_Line_Length;
- -- Maximum length of error message. The addition of Max_Line_Length
- -- ensures that two insertion tokens of maximum length can be accomodated.
- -- The value of 256 is an arbitrary value that should be more than long
- -- enough to accomodate any reasonable message.
+ Max_Msg_Length : constant := 1024 + 2 * Int (Column_Number'Last);
+ -- Maximum length of error message. The addition of 2 * Column_Number'Last
+ -- ensures that two insertion tokens of maximum length can be accommodated.
+ -- The value of 1024 is an arbitrary value that should be more than long
+ -- enough to accommodate any reasonable message (and for that matter, some
+ -- pretty unreasonable messages!)
Msg_Buffer : String (1 .. Max_Msg_Length);
-- Buffer used to prepare error messages
No_Error_Msg : constant Error_Msg_Id := 0;
-- A constant which is different from any value returned by Get_Error_Id.
- -- Typically used by a client to indicate absense of a saved Id value.
+ -- Typically used by a client to indicate absence of a saved Id value.
Cur_Msg : Error_Msg_Id := No_Error_Msg;
-- Id of most recently posted error message
-- Error_Msg routines.
function Get_Location (E : Error_Msg_Id) return Source_Ptr;
- -- Returns the flag location of the error message with the given id E.
+ -- Returns the flag location of the error message with the given id E
-----------------------------------
-- Error Message Data Structures --
-- Text of error message, fully expanded with all insertions
Next : Error_Msg_Id;
- -- Pointer to next message in error chain
+ -- Pointer to next message in error chain. A value of No_Error_Msg
+ -- indicates the end of the chain.
Sfile : Source_File_Index;
-- Source table index of source file. In the case of an error that
--------------------------
-- Pragma Warnings allows warnings to be turned off for a specified
- -- region of code, and the following tabl is the data structure used
+ -- region of code, and the following tables are the data structure used
-- to keep track of these regions.
+ -- The first table is used for the basic command line control, and for
+ -- the forms of Warning with a single ON or OFF parameter
+
-- It contains pairs of source locations, the first being the start
-- location for a warnings off region, and the second being the end
-- location. When a pragma Warnings (Off) is encountered, a new entry
-- end of the current source file. A subsequent pragma Warnings (On)
-- adjusts the end point of this entry appropriately.
- -- If all warnings are suppressed by comamnd switch, then there is a
+ -- If all warnings are suppressed by command switch, then there is a
-- dummy entry (put there by Errout.Initialize) at the start of the
-- table which covers all possible Source_Ptr values. Note that the
-- source pointer values in this table always reference the original
Table_Increment => 200,
Table_Name => "Warnings");
+ -- The second table is used for the specific forms of the pragma, where
+ -- the first argument is ON or OFF, and the second parameter is a string
+ -- which is the entire message to suppress, or a prefix of it.
+
+ type Specific_Warning_Entry is record
+ Start : Source_Ptr;
+ Stop : Source_Ptr;
+ -- Starting and ending source pointers for the range. These are always
+ -- from the same source file.
+
+ Msg : String_Ptr;
+ -- Message from pragma Warnings (Off, string)
+
+ Open : Boolean;
+ -- Set to True if OFF has been encountered with no matching ON
+
+ Used : Boolean;
+ -- Set to True if entry has been used to suppress a warning
+
+ Config : Boolean;
+ -- True if pragma is configuration pragma (in which case no matching
+ -- Off pragma is required, and it is not required that a specific
+ -- warning be suppressed).
+ end record;
+
+ package Specific_Warnings is new Table.Table (
+ Table_Component_Type => Specific_Warning_Entry,
+ Table_Index_Type => Natural,
+ Table_Low_Bound => 1,
+ Table_Initial => 100,
+ Table_Increment => 200,
+ Table_Name => "Specific_Warnings");
+
+ -- Note on handling configuration case versus specific case. A complication
+ -- arises from this example:
+
+ -- pragma Warnings (Off, "not referenced*");
+ -- procedure Mumble (X : Integer) is
+ -- pragma Warnings (On, "not referenced*");
+ -- begin
+ -- null;
+ -- end Mumble;
+
+ -- The trouble is that the first pragma is technically a configuration
+ -- pragma, and yet it is clearly being used in the context of thinking
+ -- of it as a specific case. To deal with this, what we do is that the
+ -- On entry can match a configuration pragma from the same file, and if
+ -- we find such an On entry, we cancel the indication of it being the
+ -- configuration case. This seems to handle all cases we run into ok.
+
-----------------
-- Subprograms --
-----------------
-- as all blanks, avoiding output of junk line numbers.
procedure Output_Msg_Text (E : Error_Msg_Id);
- -- Outputs characters of text in the text of the error message E, excluding
- -- any final exclamation point. Note that no end of line is output, the
- -- caller is responsible for adding the end of line.
+ -- Outputs characters of text in the text of the error message E. Note that
+ -- no end of line is output, the caller is responsible for adding the end
+ -- of line. If Error_Msg_Line_Length is non-zero, this is the routine that
+ -- splits the line generating multiple lines of output, and in this case
+ -- the last line has no terminating end of line character.
procedure Purge_Messages (From : Source_Ptr; To : Source_Ptr);
-- All error messages whose location is in the range From .. To (not
procedure Set_Msg_Blank;
-- Sets a single blank in the message if the preceding character is a
- -- non-blank character other than a left parenthesis. Has no effect if
- -- manual quote mode is turned on.
+ -- non-blank character other than a left parenthesis or minus. Has no
+ -- effect if manual quote mode is turned on.
procedure Set_Msg_Blank_Conditional;
-- Sets a single blank in the message if the preceding character is a
-- location to be referenced, and Flag is the location at which the
-- flag is posted (used to determine whether to add "in file xxx")
+ procedure Set_Msg_Insertion_Name_Literal;
+
procedure Set_Msg_Insertion_Name;
-- Handle name insertion (% insertion character)
procedure Set_Msg_Insertion_Reserved_Name;
- -- Handle insertion of reserved word name (* insertion character).
+ -- Handle insertion of reserved word name (* insertion character)
procedure Set_Msg_Insertion_Reserved_Word
(Text : String;
-- the input value of E was either already No_Error_Msg, or was the
-- last non-deleted message.
+ procedure Set_Specific_Warning_Off
+ (Loc : Source_Ptr;
+ Msg : String;
+ Config : Boolean);
+ -- This is called in response to the two argument form of pragma Warnings
+ -- where the first argument is OFF, and the second argument is a string
+ -- which identifies a specific warning to be suppressed. The first argument
+ -- is the start of the suppression range, and the second argument is the
+ -- string from the pragma. Loc is the location of the pragma (which is the
+ -- start of the range to suppress). Config is True for the configuration
+ -- pragma case (where there is no requirement for a matching OFF pragma).
+
+ procedure Set_Specific_Warning_On
+ (Loc : Source_Ptr;
+ Msg : String;
+ Err : out Boolean);
+ -- This is called in response to the two argument form of pragma Warnings
+ -- where the first argument is ON, and the second argument is a string
+ -- which identifies a specific warning to be suppressed. The first argument
+ -- is the end of the suppression range, and the second argument is the
+ -- string from the pragma. Err is set to True on return to report the error
+ -- of no matching Warnings Off pragma preceding this one.
+
procedure Set_Warnings_Mode_Off (Loc : Source_Ptr);
-- Called in response to a pragma Warnings (Off) to record the source
-- location from which warnings are to be turned off.
procedure Test_Style_Warning_Serious_Msg (Msg : String);
-- Sets Is_Warning_Msg true if Msg is a warning message (contains a
- -- question mark character), and False otherwise. Sets Is_Style_Msg
- -- true if Msg is a style message (starts with "(style)"). Sets
- -- Is_Serious_Error True unless the message is a warning or style
- -- message or contains the character | indicating a non-serious
- -- error message. Note that the call has no effect for continuation
- -- messages (those whose first character is \).
+ -- question mark character), and False otherwise. Is_Style_Msg is set true
+ -- if Msg is a style message (starts with "(style)". Sets Is_Serious_Error
+ -- True unless the message is a warning or style/info message or contains
+ -- the character | indicating a non-serious error message. Note that the
+ -- call has no effect for continuation messages (those whose first
+ -- character is '\').
function Warnings_Suppressed (Loc : Source_Ptr) return Boolean;
-- Determines if given location is covered by a warnings off suppression
-- range in the warnings table (or is suppressed by compilation option,
- -- which generates a warning range for the whole source file).
+ -- which generates a warning range for the whole source file). This routine
+ -- only deals with the general ON/OFF case, not specific warnings. True
+ -- is also returned if warnings are globally suppressed.
+
+ function Warning_Specifically_Suppressed
+ (Loc : Source_Ptr;
+ Msg : String_Ptr) return Boolean;
+ -- Determines if given message to be posted at given location is suppressed
+ -- by specific ON/OFF Warnings pragmas specifying this particular message.
+
+ type Error_Msg_Proc is
+ access procedure (Msg : String; Flag_Location : Source_Ptr);
+ procedure Validate_Specific_Warnings (Eproc : Error_Msg_Proc);
+ -- Checks that specific warnings are consistent (for non-configuration
+ -- case, properly closed, and used). The argument is a pointer to the
+ -- Error_Msg procedure to be called if any inconsistencies are detected.
end Erroutc;
OSDN Git Service
