aboutsummaryrefslogtreecommitdiffstats
path: root/src/errorout.ads
blob: f8af414a30f4032e9a69ff8406e790ce8ff85fa4 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
--  Error message handling.
--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
--
--  This program is free software: you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation, either version 2 of the License, or
--  (at your option) any later version.
--
--  This program is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU General Public License for more details.
--
--  You should have received a copy of the GNU General Public License
--  along with this program.  If not, see <gnu.org/licenses>.
with Types; use Types;

package Errorout is
   Compilation_Error: exception;

   --  The number of errors (ie, number of calls to error_msg*).
   Nbr_Errors : Natural := 0;

   --  Maximum number of errors, before silent them.
   Max_Nbr_Errors : Natural := 100;

   type Msgid_Type is
     (
      --  Any note
      Msgid_Note,

      --  Specific warnings

      --  Design unit redefines another design unit.
      Warnid_Library,

      --  Option is deprecated.
      Warnid_Deprecated_Option,

      --  Unexpected option.
      Warnid_Unexpected_Option,

      --  Missing Xref in pretty print.
      Warnid_Missing_Xref,

      --  No default binding for a component instantiation.
      Warnid_Default_Binding,

      --  Unbound component.
      Warnid_Binding,

      --  Unconnected IN port without defaults (in relaxed mode).
      Warnid_Port,

      --  Vhdl93 reserved word is used as a vhdl87 identifier.
      Warnid_Reserved_Word,

      --  Anything about pragma: unknown pragma, nested pragma...
      Warnid_Pragma,

      --  Start of block comment ('/*') appears in a block comment.
      Warnid_Nested_Comment,

      --  Use of a tool directive.
      Warnid_Directive,

      --  Weird use of parenthesis.
      Warnid_Parenthesis,

      --  Generic of a vital entity is not a vital name.
      Warnid_Vital_Generic,

      --  Delayed checks (checks performed at elaboration time).
      Warnid_Delayed_Checks,

      --  Package body is not required but is analyzed.
      Warnid_Body,

      --  An all/others specification does not apply, because there is no such
      --  named entities.
      Warnid_Specs,

      --  Incorrect use of universal value.
      Warnid_Universal,

      --  Mismatch of bounds between actual and formal in a scalar port
      --  association
      Warnid_Port_Bounds,

      --  Runtime error detected at analysis time.
      Warnid_Runtime_Error,

      --  Signal assignment creates a delta cycle in a postponed process.
      Warnid_Delta_Cycle,

      --  Declaration of a shared variable with a non-protected type.
      Warnid_Shared,

      --  A declaration hides a previous one.
      Warnid_Hide,

      --  Emit a warning when a declaration is never used.
      --  FIXME: currently only subprograms are handled.
      Warnid_Unused,

      --  Others choice is not needed, all values are already covered.
      Warnid_Others,

      --  Violation of pure rules.
      Warnid_Pure,

      --  Assertion during analysis.
      Warnid_Analyze_Assert,

      --  Incorrect use of attributes (like non-object prefix).
      Warnid_Attribute,

      --  Violation of staticness rules
      Warnid_Static,

      --  Any warning
      Msgid_Warning,

      --  Any error
      Msgid_Error,

      --  Any fatal error
      Msgid_Fatal
     );

   --  All specific warning messages.
   subtype Msgid_Warnings is Msgid_Type
     range Warnid_Library .. Warnid_Static;

   subtype Msgid_All_Warnings is Msgid_Type
     range Msgid_Warnings'First .. Msgid_Warning;

   --  Get the image of a warning.  This correspond the the identifier of ID,
   --  in lower case, without the Msgid_Warn_ prefix and with '_' replaced
   --  by '-'.
   function Warning_Image (Id : Msgid_Warnings) return String;

   --  Enable or disable a warning.
   procedure Enable_Warning (Id : Msgid_Warnings; Enable : Boolean);

   --  Get enable status of a warning.
   function Is_Warning_Enabled (Id : Msgid_Warnings) return Boolean;

   --  Consider a warning as an error.
   procedure Warning_Error (Id : Msgid_All_Warnings; As_Error : Boolean);

   --  State of warnings.
   type Warnings_Setting is private;

   --  Global control of warnings.
   --  Used to disable warnings while a referenced unit is analyzed.
   procedure Save_Warnings_Setting (Res : out Warnings_Setting);
   procedure Disable_All_Warnings;
   procedure Restore_Warnings_Setting (Res : Warnings_Setting);

   type Earg_Type is private;
   type Earg_Arr is array (Natural range <>) of Earg_Type;

   --  An empty array (for no arguments).
   No_Eargs : constant Earg_Arr;

   --  Report display:
   --  %%: %
   --  %i: identifier
   --  %c: character
   --  %t: token
   --  %l: location
   --  %n: node name
   --  %s: a string
   --  %v: value
   --  TODO: %m: mode, %y: type of
   function "+" (V : Location_Type) return Earg_Type;
   function "+" (V : Name_Id) return Earg_Type;
   function "+" (V : Character) return Earg_Type;
   function "+" (V : String8_Len_Type) return Earg_Type;
   function "+" (V : Uns32) return Earg_Type;
   function "+" (V : Int32) return Earg_Type;

   --  Convert location.
   function "+" (L : Location_Type) return Source_Coord_Type;

   --  Pass that detected the error.
   type Report_Origin is
     (Option, Library, Scan, Parse, Semantic, Elaboration);

   --  Generic report message.
   --  If ORIGIN is Option or Library, LOC must be No_Source_Coord and the
   --  program name is displayed.
   procedure Report_Msg (Id : Msgid_Type;
                         Origin : Report_Origin;
                         Loc : Source_Coord_Type;
                         Msg : String;
                         Args : Earg_Arr := No_Eargs);

   --  Group several messages (for multi-lines messages).
   --  Report_Start_Group must be called before the first Report_Msg call,
   --  and Report_End_Group after the last one.
   procedure Report_Start_Group;
   procedure Report_End_Group;

   --  Disp an error, prepended with program name.
   --  This is used for errors before initialisation, such as bad option or
   --  bad filename.
   procedure Error_Msg_Option (Msg: String);

   --  Warn about an option.
   procedure Warning_Msg_Option (Id : Msgid_Warnings; Msg: String);

   --  Low level part.

   type Error_Record is record
      Origin : Report_Origin;
      Id : Msgid_Type;

      --  Error soure file.
      File : Source_File_Entry;

      --  The first line is line 1, 0 can be used when line number is not
      --  relevant.
      Line : Natural;

      --  Offset in the line.  The first character is at offset 0.
      Offset : Natural;

      --  Length of the location (for a range).  It is assumed to be on the
      --  same line; use 0 when unknown.
      Length : Natural;
   end record;

   type Error_Start_Handler is access procedure (Err : Error_Record);
   type Message_Str_Handler is access procedure (Str : String);
   type Message_End_Handler is access procedure;
   type Message_Group_Handler is access procedure (Start : Boolean);

   type Report_Msg_Handler is record
      Error_Start : Error_Start_Handler;
      Message : Message_Str_Handler;
      Message_End : Message_End_Handler;
      Message_Group : Message_Group_Handler;
   end record;

   procedure Set_Report_Handler (Handler : Report_Msg_Handler);

   type Earg_Kind is
     (Earg_None,
      Earg_Location, Earg_Id,
      Earg_Char, Earg_String8, Earg_Uns32, Earg_Int32,
      Earg_Vhdl_Node, Earg_Vhdl_Token,
      Earg_Synth_Instance, Earg_Synth_Net, Earg_Synth_Name);

   subtype Earg_Lang_Kind is Earg_Kind range Earg_Vhdl_Node .. Earg_Kind'Last;

   type Earg_Handler is
     access procedure (Format : Character; Err : Error_Record; Val : Uns32);

   procedure Register_Earg_Handler (Kind : Earg_Kind; Handler : Earg_Handler);

   procedure Output_Quoted_Identifier (Id : Name_Id);
   procedure Output_Identifier (Id : Name_Id);
   procedure Output_Location (Err : Error_Record; Loc : Location_Type);
   procedure Output_Message (S : String);
   procedure Output_Uns32 (V : Uns32);

   function Make_Earg_Vhdl_Node (V : Uns32) return Earg_Type;
   function Make_Earg_Vhdl_Token (V : Uns32) return Earg_Type;
   function Make_Earg_Synth_Instance (V : Uns32) return Earg_Type;
   function Make_Earg_Synth_Net (V : Uns32) return Earg_Type;
   function Make_Earg_Synth_Name (V : Uns32) return Earg_Type;
private

   type Earg_Type (Kind : Earg_Kind := Earg_None) is record
      case Kind is
         when Earg_None =>
            null;
         when Earg_Location =>
            Val_Loc : Location_Type;
         when Earg_Id =>
            Val_Id : Name_Id;
         when Earg_Char =>
            Val_Char : Character;
         when Earg_String8 =>
            Val_Str8 : String8_Len_Type;
         when Earg_Uns32 =>
            Val_Uns32 : Uns32;
         when Earg_Int32 =>
            Val_Int32 : Int32;
         when Earg_Lang_Kind =>
            Val_Lang : Uns32;
      end case;
   end record;

   No_Eargs : constant Earg_Arr := (1 .. 0 => (Kind => Earg_None));

   type Warning_Control_Type is record
      Enabled : Boolean;
      Error : Boolean;
   end record;

   type Warnings_Setting is array (Msgid_All_Warnings) of Warning_Control_Type;

   Default_Warnings : constant Warnings_Setting :=
     (Warnid_Library | Warnid_Binding | Warnid_Port | Warnid_Shared
        | Warnid_Runtime_Error | Warnid_Pure | Warnid_Specs | Warnid_Hide
        | Warnid_Pragma | Warnid_Analyze_Assert | Warnid_Attribute
        | Warnid_Deprecated_Option | Warnid_Unexpected_Option
        | Msgid_Warning  => (Enabled => True, Error => False),
      Warnid_Delta_Cycle | Warnid_Body | Warnid_Static | Warnid_Nested_Comment
        | Warnid_Universal | Warnid_Port_Bounds
        | Warnid_Others | Warnid_Reserved_Word | Warnid_Directive
        | Warnid_Parenthesis | Warnid_Delayed_Checks | Warnid_Default_Binding
        | Warnid_Vital_Generic | Warnid_Missing_Xref
        | Warnid_Unused => (Enabled => False, Error => False));

   --  Compute the column from Error_Record E.
   function Get_Error_Col (E : Error_Record) return Natural;

   --  Image of VAL, without the leading space.
   function Natural_Image (Val: Natural) return String;
end Errorout;