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-2024, 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 3,  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 COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 --  This package contains global variables and routines common to error
  27 --  reporting packages, including Errout and Prj.Err.
  28
  29 with Table;
  30 with Types; use Types;
  31
  32 package Erroutc is
  33
  34    Class_Flag : Boolean := False;
  35    --  This flag is set True when outputting a reference to a class-wide
  36    --  type, and is used by Add_Class to insert 'Class at the proper point
  37
  38    Continuation : Boolean := False;
  39    --  Indicates if current message is a continuation. Initialized from the
  40    --  Msg_Cont parameter in Error_Msg_Internal and then set True if a \
  41    --  insertion character is encountered.
  42
  43    Continuation_New_Line : Boolean := False;
  44    --  Indicates if current message was a continuation line marked with \\ to
  45    --  force a new line. Set True if \\ encountered.
  46
  47    Flag_Source : Source_File_Index;
  48    --  Source file index for source file where error is being posted
  49
  50    Has_Double_Exclam : Boolean := False;
  51    --  Set true to indicate that the current message contains the insertion
  52    --  sequence !! (force warnings even in non-main unit source files).
  53
  54    Has_Error_Code : Boolean := False;
  55    --  Set true to indicate that the current message contains the insertion
  56    --  sequence [] (insert error code).
  57
  58    Has_Insertion_Line : Boolean := False;
  59    --  Set True to indicate that the current message contains the insertion
  60    --  character # (insert line number reference).
  61
  62    Is_Compile_Time_Msg : Boolean := False;
  63    --  Set true to indicate that the current message originates from a
  64    --  Compile_Time_Warning or Compile_Time_Error pragma.
  65
  66    Is_Serious_Error : Boolean := False;
  67    --  Set True for a serious error (i.e. any message that is not a warning
  68    --  or style message, and that does not contain a | insertion character).
  69
  70    Is_Unconditional_Msg : Boolean := False;
  71    --  Set True to indicate that the current message contains the insertion
  72    --  character ! and is thus to be treated as an unconditional message.
  73
  74    Is_Warning_Msg : Boolean := False;
  75    --  Set True to indicate if current message is warning message (contains ?
  76    --  or contains < and Error_Msg_Warn is True).
  77
  78    Is_Runtime_Raise : Boolean := False;
  79    --  Set to True to indicate that the current message is a warning about a
  80    --  constraint error that will be raised at runtime (contains [ and switch
  81    --  -gnatwE was given).
  82
  83    Is_Info_Msg : Boolean := False;
  84    --  Set True to indicate that the current message starts with the characters
  85    --  "info: " and is to be treated as an information message. This string
  86    --  will be prepended to the message and all its continuations.
  87
  88    Is_Check_Msg : Boolean := False;
  89    --  Set True to indicate that the current message starts with one of
  90    --  "high: ", "medium: ", "low: " and is to be treated as a check message.
  91
  92    Warning_Msg_Char : String (1 .. 2);
  93    --  Warning switch, valid only if Is_Warning_Msg is True
  94    --    "  "      -- ?   or <   appeared on its own in message
  95    --    "? "      -- ??  or <<  appeared in message
  96    --    "x "      -- ?x? or <x< appeared in message
  97    --              -- (x = a .. z | A .. Z | * | $)
  98    --    ".x"      -- ?.x? appeared in message (x = a .. z | A .. Z)
  99    --    "_x"      -- ?_x? appeared in message (x = a .. z | A .. Z)
 100    --  In the case of the < sequences, this is set only if the message is
 101    --  actually a warning, i.e. if Error_Msg_Warn is True
 102
 103    Is_Style_Msg : Boolean := False;
 104    --  Set True to indicate if the current message is a style message
 105    --  (i.e. a message whose text starts with the characters "(style)").
 106
 107    Kill_Message : Boolean := False;
 108    --  A flag used to kill weird messages (e.g. those containing uninterpreted
 109    --  implicit type references) if we have already seen at least one message
 110    --  already. The idea is that we hope the weird message is a junk cascaded
 111    --  message that should be suppressed.
 112
 113    Last_Killed : Boolean := False;
 114    --  Set True if the most recently posted non-continuation message was
 115    --  killed. This is used to determine the processing of any continuation
 116    --  messages that follow.
 117
 118    List_Pragmas_Index : Int := 0;
 119    --  Index into List_Pragmas table
 120
 121    List_Pragmas_Mode : Boolean := False;
 122    --  Starts True, gets set False by pragma List (Off), True by List (On)
 123
 124    Manual_Quote_Mode : Boolean := False;
 125    --  Set True in manual quotation mode
 126
 127    Max_Msg_Length : constant := 1024 + 2 * Int (Column_Number'Last);
 128    --  Maximum length of error message. The addition of 2 * Column_Number'Last
 129    --  ensures that two insertion tokens of maximum length can be accommodated.
 130    --  The value of 1024 is an arbitrary value that should be more than long
 131    --  enough to accommodate any reasonable message (and for that matter, some
 132    --  pretty unreasonable messages).
 133
 134    Msg_Buffer : String (1 .. Max_Msg_Length);
 135    --  Buffer used to prepare error messages
 136
 137    Msglen : Integer := 0;
 138    --  Number of characters currently stored in the message buffer
 139
 140    Suppress_Message : Boolean;
 141    --  A flag used to suppress certain obviously redundant messages (i.e.
 142    --  those referring to a node whose type is Any_Type). This suppression
 143    --  is effective only if All_Errors_Mode is off.
 144
 145    Suppress_Instance_Location : Boolean := False;
 146    --  Normally, if a # location in a message references a location within
 147    --  a generic template, then a note is added giving the location of the
 148    --  instantiation. If this variable is set True, then this note is not
 149    --  output. This is used for internal processing for the case of an
 150    --  illegal instantiation. See Error_Msg routine for further details.
 151
 152    ----------------------------
 153    -- Message ID Definitions --
 154    ----------------------------
 155
 156    type Error_Msg_Id is new Int;
 157    --  A type used to represent specific error messages. Used by the clients
 158    --  of this package only in the context of the Get_Error_Id and
 159    --  Change_Error_Text subprograms.
 160
 161    No_Error_Msg : constant Error_Msg_Id := 0;
 162    --  A constant which is different from any value returned by Get_Error_Id.
 163    --  Typically used by a client to indicate absence of a saved Id value.
 164
 165    Cur_Msg : Error_Msg_Id := No_Error_Msg;
 166    --  Id of most recently posted error message
 167
 168    function Get_Msg_Id return Error_Msg_Id;
 169    --  Returns the Id of the message most recently posted using one of the
 170    --  Error_Msg routines.
 171
 172    function Get_Location (E : Error_Msg_Id) return Source_Ptr;
 173    --  Returns the flag location of the error message with the given id E
 174
 175    -----------------------------------
 176    -- Error Message Data Structures --
 177    -----------------------------------
 178
 179    --  The error messages are stored as a linked list of error message objects
 180    --  sorted into ascending order by the source location (Sloc). Each object
 181    --  records the text of the message and its source location.
 182
 183    --  The following record type and table are used to represent error
 184    --  messages, with one entry in the table being allocated for each message.
 185
 186    type Error_Msg_Object is record
 187       Text : String_Ptr;
 188       --  Text of error message, fully expanded with all insertions
 189
 190       Next : Error_Msg_Id;
 191       --  Pointer to next message in error chain. A value of No_Error_Msg
 192       --  indicates the end of the chain.
 193
 194       Prev : Error_Msg_Id;
 195       --  Pointer to previous message in error chain. Only set during the
 196       --  Finalize procedure. A value of No_Error_Msg indicates the first
 197       --  message in the chain.
 198
 199       Sfile : Source_File_Index;
 200       --  Source table index of source file. In the case of an error that
 201       --  refers to a template, always references the original template
 202       --  not an instantiation copy.
 203
 204       Sptr : Source_Span;
 205       --  Flag pointer. In the case of an error that refers to a template,
 206       --  always references the original template, not an instantiation copy.
 207       --  This value is the actual place in the source that the error message
 208       --  will be posted. Note that an error placed on an instantiation will
 209       --  have Sptr pointing to the instantiation point.
 210
 211       Optr : Source_Span;
 212       --  Flag location used in the call to post the error. This is the same as
 213       --  Sptr, except when an error is posted on a particular instantiation of
 214       --  a generic. In such a case, Sptr will point to the original source
 215       --  location of the instantiation itself, but Optr will point to the
 216       --  template location (more accurately to the template copy in the
 217       --  instantiation copy corresponding to the instantiation referenced by
 218       --  Sptr).
 219
 220       Insertion_Sloc : Source_Ptr;
 221       --  Location in message for insertion character # when used
 222
 223       Line : Physical_Line_Number;
 224       --  Line number for error message
 225
 226       Col : Column_Number;
 227       --  Column number for error message
 228
 229       Compile_Time_Pragma : Boolean;
 230       --  True if the message originates from a Compile_Time_Warning or
 231       --  Compile_Time_Error pragma
 232
 233       Warn : Boolean;
 234       --  True if warning message
 235
 236       Info : Boolean;
 237       --  True if info message
 238
 239       Check : Boolean;
 240       --  True if check message
 241
 242       Warn_Err : Boolean;
 243       --  True if this is a warning message which is to be treated as an error
 244       --  as a result of a match with a Warning_As_Error pragma.
 245
 246       Warn_Runtime_Raise : Boolean;
 247       --  True if this a warning about a constraint error that will be raised
 248       --  at runtime.
 249
 250       Warn_Chr : String (1 .. 2);
 251       --  See Warning_Msg_Char
 252
 253       Style : Boolean;
 254       --  True if style message (starts with "(style)")
 255
 256       Serious : Boolean;
 257       --  True if serious error message (not a warning and no | character)
 258
 259       Uncond : Boolean;
 260       --  True if unconditional message (i.e. insertion character ! appeared)
 261
 262       Msg_Cont : Boolean;
 263       --  This is used for logical messages that are composed of multiple
 264       --  individual messages. For messages that are not part of such a
 265       --  group, or that are the first message in such a group. Msg_Cont
 266       --  is set to False. For subsequent messages in a group, Msg_Cont
 267       --  is set to True. This is used to make sure that such a group of
 268       --  messages is either suppressed or retained as a group (e.g. in
 269       --  the circuit that deletes identical messages).
 270
 271       Deleted : Boolean;
 272       --  If this flag is set, the message is not printed. This is used
 273       --  in the circuit for deleting duplicate/redundant error messages.
 274    end record;
 275
 276    package Errors is new Table.Table (
 277      Table_Component_Type => Error_Msg_Object,
 278      Table_Index_Type     => Error_Msg_Id,
 279      Table_Low_Bound      => 1,
 280      Table_Initial        => 200,
 281      Table_Increment      => 200,
 282      Table_Name           => "Error");
 283
 284    First_Error_Msg : Error_Msg_Id;
 285    --  The list of error messages, i.e. the first entry on the list of error
 286    --  messages. This is not the same as the physically first entry in the
 287    --  error message table, since messages are not always inserted in sequence.
 288
 289    Last_Error_Msg : Error_Msg_Id;
 290    --  The last entry on the list of error messages. Note: this is not the same
 291    --  as the physically last entry in the error message table, since messages
 292    --  are not always inserted in sequence.
 293
 294    --------------------------
 295    -- Warning Mode Control --
 296    --------------------------
 297
 298    --  Pragma Warnings allows warnings to be turned off for a specified region
 299    --  of code, and the following tables are the data structures used to keep
 300    --  track of these regions.
 301
 302    --  The first table is used for the basic command line control, and for the
 303    --  forms of Warning with a single ON or OFF parameter.
 304
 305    --  It contains pairs of source locations, the first being the start
 306    --  location for a warnings off region, and the second being the end
 307    --  location. When a pragma Warnings (Off) is encountered, a new entry is
 308    --  established extending from the location of the pragma to the end of the
 309    --  current source file. A subsequent pragma Warnings (On) adjusts the end
 310    --  point of this entry appropriately.
 311
 312    --  If all warnings are suppressed by command switch, then there is a dummy
 313    --  entry (put there by Errout.Initialize) at the start of the table which
 314    --  covers all possible Source_Ptr values. Note that the source pointer
 315    --  values in this table always reference the original template, not an
 316    --  instantiation copy, in the generic case.
 317
 318    --  Reason is the reason from the pragma Warnings (Off,..) or the null
 319    --  string if no reason parameter is given.
 320
 321    type Warnings_Entry is record
 322       Start  : Source_Ptr;
 323       Stop   : Source_Ptr;
 324       Reason : String_Id;
 325    end record;
 326
 327    package Warnings is new Table.Table (
 328      Table_Component_Type => Warnings_Entry,
 329      Table_Index_Type     => Natural,
 330      Table_Low_Bound      => 1,
 331      Table_Initial        => 100,
 332      Table_Increment      => 200,
 333      Table_Name           => "Warnings");
 334
 335    --  The second table is used for the specific forms of the pragma, where
 336    --  the first argument is ON or OFF, and the second parameter is a string
 337    --  which is the pattern to match for suppressing a warning.
 338
 339    type Specific_Warning_Entry is record
 340       Start : Source_Ptr;
 341       Stop  : Source_Ptr;
 342       --  Starting and ending source pointers for the range. These are always
 343       --  from the same source file.
 344
 345       Reason : String_Id;
 346       --  Reason string from pragma Warnings, or null string if none
 347
 348       Msg : String_Ptr;
 349       --  Message from pragma Warnings (Off, string)
 350
 351       Open : Boolean;
 352       --  Set to True if OFF has been encountered with no matching ON
 353
 354       Used : Boolean;
 355       --  Set to True if entry has been used to suppress a warning
 356
 357       Config : Boolean;
 358       --  True if pragma is configuration pragma (in which case no matching Off
 359       --  pragma is required, and it is not required that a specific warning be
 360       --  suppressed).
 361    end record;
 362
 363    package Specific_Warnings is new Table.Table (
 364      Table_Component_Type => Specific_Warning_Entry,
 365      Table_Index_Type     => Natural,
 366      Table_Low_Bound      => 1,
 367      Table_Initial        => 100,
 368      Table_Increment      => 200,
 369      Table_Name           => "Specific_Warnings");
 370
 371    --  Note on handling configuration case versus specific case. A complication
 372    --  arises from this example:
 373
 374    --     pragma Warnings (Off, "not referenced*");
 375    --     procedure Mumble (X : Integer) is
 376    --     pragma Warnings (On, "not referenced*");
 377    --     begin
 378    --        null;
 379    --     end Mumble;
 380
 381    --  The trouble is that the first pragma is technically a configuration
 382    --  pragma, and yet it is clearly being used in the context of thinking of
 383    --  it as a specific case. To deal with this, what we do is that the On
 384    --  entry can match a configuration pragma from the same file, and if we
 385    --  find such an On entry, we cancel the indication of it being the
 386    --  configuration case. This seems to handle all cases we run into ok.
 387
 388    -------------------
 389    -- Color Control --
 390    -------------------
 391
 392    Use_SGR_Control : Boolean := False;
 393    --  Set to True for enabling colored output. This should only be done when
 394    --  outputting messages to a terminal that supports it.
 395
 396    --  Colors in messages output to a terminal are controlled using SGR
 397    --  (Select Graphic Rendition).
 398
 399    Color_Separator  : constant String := ";";
 400    Color_None       : constant String := "00";
 401    Color_Bold       : constant String := "01";
 402    Color_Underscore : constant String := "04";
 403    Color_Blink      : constant String := "05";
 404    Color_Reverse    : constant String := "07";
 405    Color_Fg_Black   : constant String := "30";
 406    Color_Fg_Red     : constant String := "31";
 407    Color_Fg_Green   : constant String := "32";
 408    Color_Fg_Yellow  : constant String := "33";
 409    Color_Fg_Blue    : constant String := "34";
 410    Color_Fg_Magenta : constant String := "35";
 411    Color_Fg_Cyan    : constant String := "36";
 412    Color_Fg_White   : constant String := "37";
 413    Color_Bg_Black   : constant String := "40";
 414    Color_Bg_Red     : constant String := "41";
 415    Color_Bg_Green   : constant String := "42";
 416    Color_Bg_Yellow  : constant String := "43";
 417    Color_Bg_Blue    : constant String := "44";
 418    Color_Bg_Magenta : constant String := "45";
 419    Color_Bg_Cyan    : constant String := "46";
 420    Color_Bg_White   : constant String := "47";
 421
 422    SGR_Start        : constant String := ASCII.ESC & "[";
 423    SGR_End          : constant String := "m" & ASCII.ESC & "[K";
 424
 425    function SGR_Seq (Str : String) return String is
 426      (if Use_SGR_Control then SGR_Start & Str & SGR_End else "");
 427    --  Return the SGR control string for the commands in Str. It returns the
 428    --  empty string if Use_SGR_Control is False, so that we can insert this
 429    --  string unconditionally.
 430
 431    function SGR_Reset return String is (SGR_Seq (""));
 432    --  This ends the current section of colored output
 433
 434    --  We're using the same colors as gcc/g++ for errors/warnings/notes/locus.
 435    --  More colors are defined in gcc/g++ for other features of diagnostic
 436    --  messages (e.g. inline types, fixit) and could be used in GNAT in the
 437    --  future. The following functions start a section of colored output.
 438
 439    function SGR_Error return String is
 440      (SGR_Seq (Color_Bold & Color_Separator & Color_Fg_Red));
 441    function SGR_Warning return String is
 442      (SGR_Seq (Color_Bold & Color_Separator & Color_Fg_Magenta));
 443    function SGR_Note return String is
 444      (SGR_Seq (Color_Bold & Color_Separator & Color_Fg_Cyan));
 445    function SGR_Locus return String is
 446      (SGR_Seq (Color_Bold));
 447
 448    -----------------
 449    -- Subprograms --
 450    -----------------
 451
 452    procedure Add_Class;
 453    --  Add 'Class to buffer for class wide type case (Class_Flag set)
 454
 455    function Buffer_Ends_With (C : Character) return Boolean;
 456    --  Tests if message buffer ends with given character
 457
 458    function Buffer_Ends_With (S : String) return Boolean;
 459    --  Tests if message buffer ends with given string preceded by a space
 460
 461    procedure Buffer_Remove (C : Character);
 462    --  Remove given character from end of buffer if it is present
 463
 464    procedure Buffer_Remove (S : String);
 465    --  Removes given string from end of buffer if it is present at end of
 466    --  buffer, and preceded by a space.
 467
 468    function Compilation_Errors return Boolean;
 469    --  Returns true if errors have been detected, or warnings in -gnatwe
 470    --  (treat warnings as errors) mode.
 471
 472    procedure dmsg (Id : Error_Msg_Id);
 473    --  Debugging routine to dump an error message
 474
 475    procedure Debug_Output (N : Node_Id);
 476    --  Called from Error_Msg_N and Error_Msg_NE to generate line of debug
 477    --  output giving node number (of node N) if the debug X switch is set.
 478
 479    procedure Check_Duplicate_Message (M1, M2 : Error_Msg_Id);
 480    --  This function is passed the Id values of two error messages. If either
 481    --  M1 or M2 is a continuation message, or is already deleted, the call is
 482    --  ignored. Otherwise a check is made to see if M1 and M2 are duplicated or
 483    --  redundant. If so, the message to be deleted and all its continuations
 484    --  are marked with the Deleted flag set to True.
 485
 486    function Count_Compile_Time_Pragma_Warnings return Int;
 487    --  Returns the number of warnings in the Errors table that were triggered
 488    --  by a Compile_Time_Warning pragma.
 489
 490    function Get_Warning_Option (Id : Error_Msg_Id) return String;
 491    --  Returns the warning switch causing this warning message or an empty
 492    --  string is there is none..
 493
 494    function Get_Warning_Tag (Id : Error_Msg_Id) return String;
 495    --  Given an error message ID, return tag showing warning message class, or
 496    --  the null string if this option is not enabled or this is not a warning.
 497
 498    function Matches (S : String; P : String) return Boolean;
 499    --  Returns true if the String S matches the pattern P, which can contain
 500    --  wildcard chars (*). The entire pattern must match the entire string.
 501    --  Case is ignored in the comparison (so X matches x).
 502
 503    procedure Output_Error_Msgs (E : in out Error_Msg_Id);
 504    --  Output source line, error flag, and text of stored error message and all
 505    --  subsequent messages for the same line and unit. On return E is set to be
 506    --  one higher than the last message output.
 507
 508    procedure Output_Line_Number (L : Logical_Line_Number);
 509    --  Output a line number as six digits (with leading zeroes suppressed),
 510    --  followed by a period and a blank (note that this is 8 characters which
 511    --  means that tabs in the source line will not get messed up). Line numbers
 512    --  that match or are less than the last Source_Reference pragma are listed
 513    --  as all blanks, avoiding output of junk line numbers.
 514
 515    procedure Output_Msg_Text (E : Error_Msg_Id);
 516    --  Outputs characters of text in the text of the error message E. Note that
 517    --  no end of line is output, the caller is responsible for adding the end
 518    --  of line. If Error_Msg_Line_Length is non-zero, this is the routine that
 519    --  splits the line generating multiple lines of output, and in this case
 520    --  the last line has no terminating end of line character.
 521
 522    procedure Output_Text_Within (Txt : String_Ptr; Line_Length : Nat);
 523    --  Output the text in Txt, splitting it into lines of at most the size of
 524    --  Line_Length.
 525
 526    procedure Prescan_Message (Msg : String);
 527    --  Scans message text and sets the following variables:
 528    --
 529    --    Is_Warning_Msg is set True if Msg is a warning message (contains a
 530    --    question mark character), and False otherwise.
 531    --
 532    --    Is_Style_Msg is set True if Msg is a style message (starts with
 533    --    "(style)") and False otherwise.
 534    --
 535    --    Is_Info_Msg is set True if Msg is an information message (starts
 536    --    with "info: ". Such messages must contain a ? sequence since they
 537    --    are also considered to be warning messages, and get a tag.
 538    --
 539    --    Is_Serious_Error is set to True unless the message is a warning or
 540    --    style message or contains the character | (non-serious error).
 541    --
 542    --    Is_Unconditional_Msg is set True if the message contains the character
 543    --    ! and is otherwise set False.
 544    --
 545    --    Has_Double_Exclam is set True if the message contains the sequence !!
 546    --    and is otherwise set False.
 547    --
 548    --    Has_Error_Code is set True if the message contains the sequence []
 549    --    and is otherwise set False.
 550    --
 551    --    Has_Insertion_Line is set True if the message contains the character #
 552    --    and is otherwise set False.
 553    --
 554    --  We need to know right away these aspects of a message, since we will
 555    --  test these values before doing the full error scan.
 556    --
 557    --  Note that the call has no effect for continuation messages (those whose
 558    --  first character is '\') except for the Has_Insertion_Line setting.
 559
 560    procedure Purge_Messages (From : Source_Ptr; To : Source_Ptr);
 561    --  All error messages whose location is in the range From .. To (not
 562    --  including the end points) will be deleted from the error listing.
 563
 564    function Same_Error (M1, M2 : Error_Msg_Id) return Boolean;
 565    --  See if two messages have the same text. Returns true if the text of the
 566    --  two messages is identical, or if one of them is the same as the other
 567    --  with an appended "instance at xxx" tag.
 568
 569    procedure Set_Msg_Blank;
 570    --  Sets a single blank in the message if the preceding character is a
 571    --  non-blank character other than a left parenthesis or minus. Has no
 572    --  effect if manual quote mode is turned on.
 573
 574    procedure Set_Msg_Blank_Conditional;
 575    --  Sets a single blank in the message if the preceding character is a
 576    --  non-blank character other than a left parenthesis or quote. Has no
 577    --  effect if manual quote mode is turned on.
 578
 579    procedure Set_Msg_Char (C : Character);
 580    --  Add a single character to the current message. This routine does not
 581    --  check for special insertion characters (they are just treated as text
 582    --  characters if they occur).
 583
 584    procedure Set_Msg_Insertion_Code;
 585    --  Handle error code insertion ([] insertion character)
 586
 587    procedure Set_Msg_Insertion_File_Name;
 588    --  Handle file name insertion (left brace insertion character)
 589
 590    procedure Set_Msg_Insertion_Line_Number (Loc, Flag : Source_Ptr);
 591    --  Handle line number insertion (# insertion character). Loc is the
 592    --  location to be referenced, and Flag is the location at which the
 593    --  flag is posted (used to determine whether to add "in file xxx")
 594
 595    procedure Set_Msg_Insertion_Name_Literal;
 596
 597    procedure Set_Msg_Insertion_Name;
 598    --  Handle name insertion (% insertion character)
 599
 600    procedure Set_Msg_Insertion_Reserved_Name;
 601    --  Handle insertion of reserved word name (* insertion character)
 602
 603    procedure Set_Msg_Insertion_Reserved_Word
 604      (Text : String;
 605       J    : in out Integer);
 606    --  Handle reserved word insertion (upper case letters). The Text argument
 607    --  is the current error message input text, and J is an index which on
 608    --  entry points to the first character of the reserved word, and on exit
 609    --  points past the last character of the reserved word. Note that RM and
 610    --  SPARK are treated specially and not considered to be keywords.
 611
 612    procedure Set_Msg_Insertion_Run_Time_Name;
 613    --  If package System contains a definition for Run_Time_Name (see package
 614    --  Targparm for details), then this procedure will insert a message of
 615    --  the form (name) into the current error message, with name set in mixed
 616    --  case (upper case after any spaces). If no run time name is defined,
 617    --  then this routine has no effect).
 618
 619    procedure Set_Msg_Insertion_Uint;
 620    --  Handle Uint insertion (^ insertion character)
 621
 622    procedure Set_Msg_Int (Line : Int);
 623    --  Set the decimal representation of the argument in the error message
 624    --  buffer with no leading zeroes output.
 625
 626    procedure Set_Msg_Name_Buffer;
 627    --  Output name from Namet.Global_Name_Buffer, with surrounding quotes
 628    --  unless manual quotation mode is in effect.
 629
 630    procedure Set_Msg_Quote;
 631    --  Set quote if in normal quote mode, nothing if in manual quote mode
 632
 633    procedure Set_Msg_Str (Text : String);
 634    --  Add a sequence of characters to the current message. This routine does
 635    --  not check for special insertion characters (they are just treated as
 636    --  text characters if they occur). It does perform the transformation of
 637    --  the special strings _xxx (xxx = Pre/Post/Type_Invariant) to xxx'Class.
 638
 639    procedure Set_Next_Non_Deleted_Msg (E : in out Error_Msg_Id);
 640    --  Given a message id, move to next message id, but skip any deleted
 641    --  messages, so that this results in E on output being the first non-
 642    --  deleted message following the input value of E, or No_Error_Msg if
 643    --  the input value of E was either already No_Error_Msg, or was the
 644    --  last non-deleted message.
 645
 646    procedure Set_Specific_Warning_Off
 647      (Node   : Node_Id;
 648       Msg    : String;
 649       Reason : String_Id;
 650       Config : Boolean;
 651       Used   : Boolean := False);
 652    --  This is called in response to the two argument form of pragma Warnings
 653    --  where the first argument is OFF, and the second argument is a string
 654    --  which identifies a specific warning to be suppressed. The first argument
 655    --  is the corresponding N_Pragma node, and the second argument is the
 656    --  string from the pragma. Sloc (Node) is the start of the range to
 657    --  suppress. Reason is the reason string from the pragma, or the null
 658    --  string if no reason is given. Config is True for the configuration
 659    --  pragma case (where there is no requirement for a matching OFF pragma).
 660    --  Used is set True to disable the check that the warning actually has the
 661    --  effect of suppressing a warning.
 662
 663    procedure Set_Specific_Warning_On
 664      (Loc : Source_Ptr;
 665       Msg : String;
 666       Err : out Boolean);
 667    --  This is called in response to the two argument form of pragma Warnings
 668    --  where the first argument is ON, and the second argument is a string
 669    --  which identifies a specific warning to be suppressed. The first argument
 670    --  is the end of the suppression range, and the second argument is the
 671    --  string from the pragma. Err is set to True on return to report the error
 672    --  of no matching Warnings Off pragma preceding this one.
 673
 674    procedure Set_Warnings_Mode_Off (Loc : Source_Ptr; Reason : String_Id);
 675    --  Called in response to a pragma Warnings (Off) to record the source
 676    --  location from which warnings are to be turned off. Reason is the
 677    --  Reason from the pragma, or the null string if none is given.
 678
 679    procedure Set_Warnings_Mode_On (Loc : Source_Ptr);
 680    --  Called in response to a pragma Warnings (On) to record the source
 681    --  location from which warnings are to be turned back on.
 682
 683    function Warnings_Suppressed (Loc : Source_Ptr) return String_Id;
 684    --  Determines if given location is covered by a warnings off suppression
 685    --  range in the warnings table (or is suppressed by compilation option,
 686    --  which generates a warning range for the whole source file). This routine
 687    --  only deals with the general ON/OFF case, not specific warnings. The
 688    --  returned result is No_String if warnings are not suppressed. If warnings
 689    --  are suppressed for the given location, then corresponding Reason
 690    --  parameter from the pragma is returned (or the null string if no Reason
 691    --  parameter was present).
 692
 693    function Warning_Specifically_Suppressed
 694      (Loc : Source_Ptr;
 695       Msg : String_Ptr;
 696       Tag : String := "") return String_Id;
 697    --  Determines if given message to be posted at given location is suppressed
 698    --  by specific ON/OFF Warnings pragmas specifying this particular message.
 699    --  If the warning is not suppressed then No_String is returned, otherwise
 700    --  the corresponding warning string is returned (or the null string if no
 701    --  Warning argument was present in the pragma). Tag is the error message
 702    --  tag for the message in question or the null string if there is no tag.
 703    --
 704    --  Note: we have a null default for Tag to deal with calls from an old
 705    --  branch of gnat2why, which does not know about tags in the calls but
 706    --  which uses the latest version of erroutc.
 707
 708    function Warning_Treated_As_Error (Msg : String) return Boolean;
 709    --  Returns True if the warning message Msg matches any of the strings
 710    --  given by Warning_As_Error pragmas, as stored in the Warnings_As_Errors
 711    --  table.
 712
 713 end Erroutc;