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