------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- E R R O U T C --
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2004 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- --
-- 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. --
-- --
-- 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 Table;
with Types; use Types;
package Erroutc is
Class_Flag : Boolean := False;
-- This flag is set True when outputting a reference to a class-wide
-- 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
-- Msg_Cont parameter in Error_Msg_Internal and then set True if a \
-- insertion character is encountered.
Flag_Source : Source_File_Index;
-- Source file index for source file where error is being posted
Is_Warning_Msg : Boolean := False;
-- Set True to indicate if current message is warning message
Is_Style_Msg : Boolean := False;
-- Set True to indicate if the current message is a style message
Is_Serious_Error : Boolean := False;
-- Set by Set_Msg_Text to indicate if current message is serious error
Is_Unconditional_Msg : Boolean := False;
-- Set by Set_Msg_Text to indicate if current message is unconditional
Kill_Message : Boolean := False;
-- A flag used to kill weird messages (e.g. those containing uninterpreted
-- implicit type references) if we have already seen at least one message
-- already. The idea is that we hope the weird message is a junk cascaded
-- message that should be suppressed.
Last_Killed : Boolean := False;
-- Set True if the most recently posted non-continuation message was
-- killed. This is used to determine the processing of any continuation
-- messages that follow.
List_Pragmas_Index : Int := 0;
-- Index into List_Pragmas table
List_Pragmas_Mode : Boolean := False;
-- Starts True, gets set False by pragma List (Off), True by List (On)
Manual_Quote_Mode : Boolean := False;
-- Set True in manual quotation mode
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 accomodated.
-- The value of 1024 is an arbitrary value that should be more than long
-- enough to accomodate any reasonable message (and for that matter, some
-- pretty unreasonable messages!)
Msg_Buffer : String (1 .. Max_Msg_Length);
-- Buffer used to prepare error messages
Msglen : Integer := 0;
-- Number of characters currently stored in the message buffer
Suppress_Message : Boolean;
-- A flag used to suppress certain obviously redundant messages (i.e.
-- those referring to a node whose type is Any_Type). This suppression
-- is effective only if All_Errors_Mode is off.
Suppress_Instance_Location : Boolean := False;
-- Normally, if a # location in a message references a location within
-- a generic template, then a note is added giving the location of the
-- instantiation. If this variable is set True, then this note is not
-- output. This is used for internal processing for the case of an
-- illegal instantiation. See Error_Msg routine for further details.
----------------------------
-- Message ID Definitions --
----------------------------
type Error_Msg_Id is new Int;
-- A type used to represent specific error messages. Used by the clients
-- of this package only in the context of the Get_Error_Id and
-- Change_Error_Text subprograms.
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.
Cur_Msg : Error_Msg_Id := No_Error_Msg;
-- Id of most recently posted error message
function Get_Msg_Id return Error_Msg_Id;
-- Returns the Id of the message most recently posted using one of the
-- 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.
-----------------------------------
-- Error Message Data Structures --
-----------------------------------
-- The error messages are stored as a linked list of error message objects
-- sorted into ascending order by the source location (Sloc). Each object
-- records the text of the message and its source location.
-- The following record type and table are used to represent error
-- messages, with one entry in the table being allocated for each message.
type Error_Msg_Object is record
Text : String_Ptr;
-- Text of error message, fully expanded with all insertions
Next : Error_Msg_Id;
-- Pointer to next message in error chain
Sfile : Source_File_Index;
-- Source table index of source file. In the case of an error that
-- refers to a template, always references the original template
-- not an instantiation copy.
Sptr : Source_Ptr;
-- Flag pointer. In the case of an error that refers to a template,
-- always references the original template, not an instantiation copy.
-- This value is the actual place in the source that the error message
-- will be posted. Note that an error placed on an instantiation will
-- have Sptr pointing to the instantiation point.
Optr : Source_Ptr;
-- Flag location used in the call to post the error. This is normally
-- the same as Sptr, except when an error is posted on a particular
-- instantiation of a generic. In such a case, Sptr will point to
-- the original source location of the instantiation itself, but
-- Optr will point to the template location (more accurately to the
-- template copy in the instantiation copy corresponding to the
-- instantiation referenced by Sptr).
Line : Physical_Line_Number;
-- Line number for error message
Col : Column_Number;
-- Column number for error message
Warn : Boolean;
-- True if warning message (i.e. insertion character ? appeared)
Style : Boolean;
-- True if style message (starts with "(style)")
Serious : Boolean;
-- True if serious error message (not a warning and no | character)
Uncond : Boolean;
-- True if unconditional message (i.e. insertion character ! appeared)
Msg_Cont : Boolean;
-- This is used for logical messages that are composed of multiple
-- individual messages. For messages that are not part of such a
-- group, or that are the first message in such a group. Msg_Cont
-- is set to False. For subsequent messages in a group, Msg_Cont
-- is set to True. This is used to make sure that such a group of
-- messages is either suppressed or retained as a group (e.g. in
-- the circuit that deletes identical messages).
Deleted : Boolean;
-- If this flag is set, the message is not printed. This is used
-- in the circuit for deleting duplicate/redundant error messages.
end record;
package Errors is new Table.Table (
Table_Component_Type => Error_Msg_Object,
Table_Index_Type => Error_Msg_Id,
Table_Low_Bound => 1,
Table_Initial => 200,
Table_Increment => 200,
Table_Name => "Error");
First_Error_Msg : Error_Msg_Id;
-- The list of error messages, i.e. the first entry on the list of error
-- messages. This is not the same as the physically first entry in the
-- error message table, since messages are not always inserted in sequence.
Last_Error_Msg : Error_Msg_Id;
-- The last entry on the list of error messages. Note that this is not
-- the same as the physically last entry in the error message table, since
-- messages are not always inserted in sequence.
--------------------------
-- Warning Mode Control --
--------------------------
-- Pragma Warnings allows warnings to be turned off for a specified
-- region of code, and the following tabl is the data structure used
-- to keep track of these regions.
-- 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
-- is established extending from the location of the pragma to the
-- 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
-- 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
-- template, not an instantiation copy, in the generic case.
type Warnings_Entry is record
Start : Source_Ptr;
Stop : Source_Ptr;
end record;
package Warnings is new Table.Table (
Table_Component_Type => Warnings_Entry,
Table_Index_Type => Natural,
Table_Low_Bound => 1,
Table_Initial => 100,
Table_Increment => 200,
Table_Name => "Warnings");
-----------------
-- Subprograms --
-----------------
procedure Add_Class;
-- Add 'Class to buffer for class wide type case (Class_Flag set)
function Buffer_Ends_With (S : String) return Boolean;
-- Tests if message buffer ends with given string preceded by a space
procedure Buffer_Remove (S : String);
-- Removes given string from end of buffer if it is present
-- at end of buffer, and preceded by a space.
function Compilation_Errors return Boolean;
-- Returns true if errors have been detected, or warnings in -gnatwe
-- (treat warnings as errors) mode.
procedure dmsg (Id : Error_Msg_Id);
-- Debugging routine to dump an error message
procedure Debug_Output (N : Node_Id);
-- Called from Error_Msg_N and Error_Msg_NE to generate line of debug
-- output giving node number (of node N) if the debug X switch is set.
procedure Check_Duplicate_Message (M1, M2 : Error_Msg_Id);
-- This function is passed the Id values of two error messages. If
-- either M1 or M2 is a continuation message, or is already deleted,
-- the call is ignored. Otherwise a check is made to see if M1 and M2
-- are duplicated or redundant. If so, the message to be deleted and
-- all its continuations are marked with the Deleted flag set to True.
procedure Output_Error_Msgs (E : in out Error_Msg_Id);
-- Output source line, error flag, and text of stored error message and
-- all subsequent messages for the same line and unit. On return E is
-- set to be one higher than the last message output.
procedure Output_Line_Number (L : Logical_Line_Number);
-- Output a line number as six digits (with leading zeroes suppressed),
-- followed by a period and a blank (note that this is 8 characters which
-- means that tabs in the source line will not get messed up). Line numbers
-- that match or are less than the last Source_Reference pragma are listed
-- 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.
procedure Purge_Messages (From : Source_Ptr; To : Source_Ptr);
-- All error messages whose location is in the range From .. To (not
-- including the end points) will be deleted from the error listing.
function Same_Error (M1, M2 : Error_Msg_Id) return Boolean;
-- See if two messages have the same text. Returns true if the text
-- of the two messages is identical, or if one of them is the same
-- as the other with an appended "instance at xxx" tag.
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.
procedure Set_Msg_Blank_Conditional;
-- Sets a single blank in the message if the preceding character is a
-- non-blank character other than a left parenthesis or quote. Has no
-- effect if manual quote mode is turned on.
procedure Set_Msg_Char (C : Character);
-- Add a single character to the current message. This routine does not
-- check for special insertion characters (they are just treated as text
-- characters if they occur).
procedure Set_Msg_Insertion_File_Name;
-- Handle file name insertion (left brace insertion character)
procedure Set_Msg_Insertion_Line_Number (Loc, Flag : Source_Ptr);
-- Handle line number insertion (# insertion character). Loc is the
-- 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;
-- Handle name insertion (% insertion character)
procedure Set_Msg_Insertion_Reserved_Name;
-- Handle insertion of reserved word name (* insertion character).
procedure Set_Msg_Insertion_Reserved_Word
(Text : String;
J : in out Integer);
-- Handle reserved word insertion (upper case letters). The Text argument
-- is the current error message input text, and J is an index which on
-- entry points to the first character of the reserved word, and on exit
-- points past the last character of the reserved word.
procedure Set_Msg_Insertion_Run_Time_Name;
-- If package System contains a definition for Run_Time_Name (see package
-- Targparm for details), then this procedure will insert a message of
-- the form (name) into the current error message, with name set in mixed
-- case (upper case after any spaces). If no run time name is defined,
-- then this routine has no effect).
procedure Set_Msg_Insertion_Uint;
-- Handle Uint insertion (^ insertion character)
procedure Set_Msg_Int (Line : Int);
-- Set the decimal representation of the argument in the error message
-- buffer with no leading zeroes output.
procedure Set_Msg_Name_Buffer;
-- Output name from Name_Buffer, with surrounding quotes unless manual
-- quotation mode is in effect.
procedure Set_Msg_Quote;
-- Set quote if in normal quote mode, nothing if in manual quote mode
procedure Set_Msg_Str (Text : String);
-- Add a sequence of characters to the current message. This routine does
-- not check for special insertion characters (they are just treated as
-- text characters if they occur).
procedure Set_Next_Non_Deleted_Msg (E : in out Error_Msg_Id);
-- Given a message id, move to next message id, but skip any deleted
-- messages, so that this results in E on output being the first non-
-- deleted message following the input value of E, or No_Error_Msg if
-- the input value of E was either already No_Error_Msg, or was the
-- last non-deleted message.
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 Set_Warnings_Mode_On (Loc : Source_Ptr);
-- Called in response to a pragma Warnings (On) to record the source
-- location from which warnings are to be turned back on.
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 \).
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).
end Erroutc;