1--  Error message handling.
2--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
3--
4--  This program is free software: you can redistribute it and/or modify
5--  it under the terms of the GNU General Public License as published by
6--  the Free Software Foundation, either version 2 of the License, or
7--  (at your option) any later version.
8--
9--  This program is distributed in the hope that it will be useful,
10--  but WITHOUT ANY WARRANTY; without even the implied warranty of
11--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12--  GNU General Public License for more details.
13--
14--  You should have received a copy of the GNU General Public License
15--  along with this program.  If not, see <gnu.org/licenses>.
16with Types; use Types;
17
18package Errorout is
19   Compilation_Error: exception;
20
21   --  The number of errors (ie, number of calls to error_msg*).
22   Nbr_Errors : Natural := 0;
23
24   --  Maximum number of errors, before silent them.
25   Max_Nbr_Errors : Natural := 100;
26
27   type Msgid_Type is
28     (
29      --  Any note
30      Msgid_Note,
31
32      --  Specific warnings
33
34      --  Design unit redefines another design unit.
35      Warnid_Library,
36
37      --  Option is deprecated.
38      Warnid_Deprecated_Option,
39
40      --  Unexpected option.
41      Warnid_Unexpected_Option,
42
43      --  Missing Xref in pretty print.
44      Warnid_Missing_Xref,
45
46      --  No default binding for a component instantiation.
47      Warnid_Default_Binding,
48
49      --  Unbound component.
50      Warnid_Binding,
51
52      --  Unconnected IN port without defaults (in relaxed mode).
53      Warnid_Port,
54
55      --  Vhdl93 reserved word is used as a vhdl87 identifier.
56      Warnid_Reserved_Word,
57
58      --  Anything about pragma: unknown pragma, nested pragma...
59      Warnid_Pragma,
60
61      --  Start of block comment ('/*') appears in a block comment.
62      Warnid_Nested_Comment,
63
64      --  Use of a tool directive.
65      Warnid_Directive,
66
67      --  Weird use of parenthesis.
68      Warnid_Parenthesis,
69
70      --  Generic of a vital entity is not a vital name.
71      Warnid_Vital_Generic,
72
73      --  Delayed checks (checks performed at elaboration time).
74      Warnid_Delayed_Checks,
75
76      --  Package body is not required but is analyzed.
77      Warnid_Body,
78
79      --  An all/others specification does not apply, because there is no such
80      --  named entities.
81      Warnid_Specs,
82
83      --  Incorrect use of universal value.
84      Warnid_Universal,
85
86      --  Mismatch of bounds between actual and formal in a scalar port
87      --  association
88      Warnid_Port_Bounds,
89
90      --  Runtime error detected at analysis time.
91      Warnid_Runtime_Error,
92
93      --  Signal assignment creates a delta cycle in a postponed process.
94      Warnid_Delta_Cycle,
95
96      --  Declaration of a shared variable with a non-protected type.
97      Warnid_Shared,
98
99      --  A declaration hides a previous one.
100      Warnid_Hide,
101
102      --  Emit a warning when a declaration is never used.
103      --  FIXME: currently only subprograms are handled.
104      Warnid_Unused,
105
106      --  Others choice is not needed, all values are already covered.
107      Warnid_Others,
108
109      --  Violation of pure rules.
110      Warnid_Pure,
111
112      --  Assertion during analysis.
113      Warnid_Analyze_Assert,
114
115      --  Incorrect use of attributes (like non-object prefix).
116      Warnid_Attribute,
117
118      --  Violation of staticness rules
119      Warnid_Static,
120
121      --  Any warning
122      Msgid_Warning,
123
124      --  Any error
125      Msgid_Error,
126
127      --  Any fatal error
128      Msgid_Fatal
129     );
130
131   --  All specific warning messages.
132   subtype Msgid_Warnings is Msgid_Type
133     range Warnid_Library .. Warnid_Static;
134
135   subtype Msgid_All_Warnings is Msgid_Type
136     range Msgid_Warnings'First .. Msgid_Warning;
137
138   --  Get the image of a warning.  This correspond the the identifier of ID,
139   --  in lower case, without the Msgid_Warn_ prefix and with '_' replaced
140   --  by '-'.
141   function Warning_Image (Id : Msgid_Warnings) return String;
142
143   --  Enable or disable a warning.
144   procedure Enable_Warning (Id : Msgid_Warnings; Enable : Boolean);
145
146   --  Get enable status of a warning.
147   function Is_Warning_Enabled (Id : Msgid_Warnings) return Boolean;
148
149   --  Consider a warning as an error.
150   procedure Warning_Error (Id : Msgid_All_Warnings; As_Error : Boolean);
151
152   --  State of warnings.
153   type Warnings_Setting is private;
154
155   --  Global control of warnings.
156   --  Used to disable warnings while a referenced unit is analyzed.
157   procedure Save_Warnings_Setting (Res : out Warnings_Setting);
158   procedure Disable_All_Warnings;
159   procedure Restore_Warnings_Setting (Res : Warnings_Setting);
160
161   type Earg_Type is private;
162   type Earg_Arr is array (Natural range <>) of Earg_Type;
163
164   --  An empty array (for no arguments).
165   No_Eargs : constant Earg_Arr;
166
167   --  Report display:
168   --  %%: %
169   --  %i: identifier
170   --  %c: character
171   --  %t: token
172   --  %l: location
173   --  %n: node name
174   --  %s: a string
175   --  %v: value
176   --  TODO: %m: mode, %y: type of
177   function "+" (V : Location_Type) return Earg_Type;
178   function "+" (V : Name_Id) return Earg_Type;
179   function "+" (V : Character) return Earg_Type;
180   function "+" (V : String8_Len_Type) return Earg_Type;
181   function "+" (V : Uns32) return Earg_Type;
182   function "+" (V : Int32) return Earg_Type;
183
184   --  Convert location.
185   function "+" (L : Location_Type) return Source_Coord_Type;
186
187   --  Pass that detected the error.
188   type Report_Origin is
189     (Option, Library, Scan, Parse, Semantic, Elaboration);
190
191   --  Generic report message.
192   --  If ORIGIN is Option or Library, LOC must be No_Source_Coord and the
193   --  program name is displayed.
194   procedure Report_Msg (Id : Msgid_Type;
195                         Origin : Report_Origin;
196                         Loc : Source_Coord_Type;
197                         Msg : String;
198                         Args : Earg_Arr := No_Eargs);
199
200   --  Group several messages (for multi-lines messages).
201   --  Report_Start_Group must be called before the first Report_Msg call,
202   --  and Report_End_Group after the last one.
203   procedure Report_Start_Group;
204   procedure Report_End_Group;
205
206   --  Disp an error, prepended with program name.
207   --  This is used for errors before initialisation, such as bad option or
208   --  bad filename.
209   procedure Error_Msg_Option (Msg: String);
210
211   --  Warn about an option.
212   procedure Warning_Msg_Option (Id : Msgid_Warnings; Msg: String);
213
214   --  Low level part.
215
216   type Error_Record is record
217      Origin : Report_Origin;
218      Id : Msgid_Type;
219
220      --  Error soure file.
221      File : Source_File_Entry;
222
223      --  The first line is line 1, 0 can be used when line number is not
224      --  relevant.
225      Line : Natural;
226
227      --  Offset in the line.  The first character is at offset 0.
228      Offset : Natural;
229
230      --  Length of the location (for a range).  It is assumed to be on the
231      --  same line; use 0 when unknown.
232      Length : Natural;
233   end record;
234
235   type Error_Start_Handler is access procedure (Err : Error_Record);
236   type Message_Str_Handler is access procedure (Str : String);
237   type Message_End_Handler is access procedure;
238   type Message_Group_Handler is access procedure (Start : Boolean);
239
240   type Report_Msg_Handler is record
241      Error_Start : Error_Start_Handler;
242      Message : Message_Str_Handler;
243      Message_End : Message_End_Handler;
244      Message_Group : Message_Group_Handler;
245   end record;
246
247   procedure Set_Report_Handler (Handler : Report_Msg_Handler);
248
249   type Earg_Kind is
250     (Earg_None,
251      Earg_Location, Earg_Id,
252      Earg_Char, Earg_String8, Earg_Uns32, Earg_Int32,
253      Earg_Vhdl_Node, Earg_Vhdl_Token,
254      Earg_Synth_Instance, Earg_Synth_Net, Earg_Synth_Name);
255
256   subtype Earg_Lang_Kind is Earg_Kind range Earg_Vhdl_Node .. Earg_Kind'Last;
257
258   type Earg_Handler is
259     access procedure (Format : Character; Err : Error_Record; Val : Uns32);
260
261   procedure Register_Earg_Handler (Kind : Earg_Kind; Handler : Earg_Handler);
262
263   procedure Output_Quoted_Identifier (Id : Name_Id);
264   procedure Output_Identifier (Id : Name_Id);
265   procedure Output_Location (Err : Error_Record; Loc : Location_Type);
266   procedure Output_Message (S : String);
267   procedure Output_Uns32 (V : Uns32);
268
269   function Make_Earg_Vhdl_Node (V : Uns32) return Earg_Type;
270   function Make_Earg_Vhdl_Token (V : Uns32) return Earg_Type;
271   function Make_Earg_Synth_Instance (V : Uns32) return Earg_Type;
272   function Make_Earg_Synth_Net (V : Uns32) return Earg_Type;
273   function Make_Earg_Synth_Name (V : Uns32) return Earg_Type;
274private
275
276   type Earg_Type (Kind : Earg_Kind := Earg_None) is record
277      case Kind is
278         when Earg_None =>
279            null;
280         when Earg_Location =>
281            Val_Loc : Location_Type;
282         when Earg_Id =>
283            Val_Id : Name_Id;
284         when Earg_Char =>
285            Val_Char : Character;
286         when Earg_String8 =>
287            Val_Str8 : String8_Len_Type;
288         when Earg_Uns32 =>
289            Val_Uns32 : Uns32;
290         when Earg_Int32 =>
291            Val_Int32 : Int32;
292         when Earg_Lang_Kind =>
293            Val_Lang : Uns32;
294      end case;
295   end record;
296
297   No_Eargs : constant Earg_Arr := (1 .. 0 => (Kind => Earg_None));
298
299   type Warning_Control_Type is record
300      Enabled : Boolean;
301      Error : Boolean;
302   end record;
303
304   type Warnings_Setting is array (Msgid_All_Warnings) of Warning_Control_Type;
305
306   Default_Warnings : constant Warnings_Setting :=
307     (Warnid_Library | Warnid_Binding | Warnid_Port | Warnid_Shared
308        | Warnid_Runtime_Error | Warnid_Pure | Warnid_Specs | Warnid_Hide
309        | Warnid_Pragma | Warnid_Analyze_Assert | Warnid_Attribute
310        | Warnid_Deprecated_Option | Warnid_Unexpected_Option
311        | Msgid_Warning  => (Enabled => True, Error => False),
312      Warnid_Delta_Cycle | Warnid_Body | Warnid_Static | Warnid_Nested_Comment
313        | Warnid_Universal | Warnid_Port_Bounds
314        | Warnid_Others | Warnid_Reserved_Word | Warnid_Directive
315        | Warnid_Parenthesis | Warnid_Delayed_Checks | Warnid_Default_Binding
316        | Warnid_Vital_Generic | Warnid_Missing_Xref
317        | Warnid_Unused => (Enabled => False, Error => False));
318
319   --  Compute the column from Error_Record E.
320   function Get_Error_Col (E : Error_Record) return Natural;
321
322   --  Image of VAL, without the leading space.
323   function Natural_Image (Val: Natural) return String;
324end Errorout;
325