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-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
  30 with Hostparm;
  31 with Table;
  32 with Types;  use Types;
  33
  34 package 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
 398 end Erroutc;