gcc/ada/erroutc.ads

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