OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [erroutc.ads] - Blame information for rev 706

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 706 jeremybenn
------------------------------------------------------------------------------
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-2011, 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 packages 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
   Is_Warning_Msg : Boolean := False;
51
   --  Set True to indicate if current message is warning message
52
 
53
   Is_Style_Msg : Boolean := False;
54
   --  Set True to indicate if the current message is a style message
55
   --  (i.e. a message whose text starts with the characters "(style)").
56
 
57
   Is_Serious_Error : Boolean := False;
58
   --  Set by Set_Msg_Text to indicate if current message is serious error
59
 
60
   Is_Unconditional_Msg : Boolean := False;
61
   --  Set by Set_Msg_Text to indicate if current message is unconditional
62
 
63
   Kill_Message : Boolean := False;
64
   --  A flag used to kill weird messages (e.g. those containing uninterpreted
65
   --  implicit type references) if we have already seen at least one message
66
   --  already. The idea is that we hope the weird message is a junk cascaded
67
   --  message that should be suppressed.
68
 
69
   Last_Killed : Boolean := False;
70
   --  Set True if the most recently posted non-continuation message was
71
   --  killed. This is used to determine the processing of any continuation
72
   --  messages that follow.
73
 
74
   List_Pragmas_Index : Int := 0;
75
   --  Index into List_Pragmas table
76
 
77
   List_Pragmas_Mode : Boolean := False;
78
   --  Starts True, gets set False by pragma List (Off), True by List (On)
79
 
80
   Manual_Quote_Mode : Boolean := False;
81
   --  Set True in manual quotation mode
82
 
83
   Max_Msg_Length : constant := 1024 + 2 * Int (Column_Number'Last);
84
   --  Maximum length of error message. The addition of 2 * Column_Number'Last
85
   --  ensures that two insertion tokens of maximum length can be accommodated.
86
   --  The value of 1024 is an arbitrary value that should be more than long
87
   --  enough to accommodate any reasonable message (and for that matter, some
88
   --  pretty unreasonable messages!)
89
 
90
   Msg_Buffer : String (1 .. Max_Msg_Length);
91
   --  Buffer used to prepare error messages
92
 
93
   Msglen : Integer := 0;
94
   --  Number of characters currently stored in the message buffer
95
 
96
   Suppress_Message : Boolean;
97
   --  A flag used to suppress certain obviously redundant messages (i.e.
98
   --  those referring to a node whose type is Any_Type). This suppression
99
   --  is effective only if All_Errors_Mode is off.
100
 
101
   Suppress_Instance_Location : Boolean := False;
102
   --  Normally, if a # location in a message references a location within
103
   --  a generic template, then a note is added giving the location of the
104
   --  instantiation. If this variable is set True, then this note is not
105
   --  output. This is used for internal processing for the case of an
106
   --  illegal instantiation. See Error_Msg routine for further details.
107
 
108
   ----------------------------
109
   -- Message ID Definitions --
110
   ----------------------------
111
 
112
   type Error_Msg_Id is new Int;
113
   --  A type used to represent specific error messages. Used by the clients
114
   --  of this package only in the context of the Get_Error_Id and
115
   --  Change_Error_Text subprograms.
116
 
117
   No_Error_Msg : constant Error_Msg_Id := 0;
118
   --  A constant which is different from any value returned by Get_Error_Id.
119
   --  Typically used by a client to indicate absence of a saved Id value.
120
 
121
   Cur_Msg : Error_Msg_Id := No_Error_Msg;
122
   --  Id of most recently posted error message
123
 
124
   function Get_Msg_Id return Error_Msg_Id;
125
   --  Returns the Id of the message most recently posted using one of the
126
   --  Error_Msg routines.
127
 
128
   function Get_Location (E : Error_Msg_Id) return Source_Ptr;
129
   --  Returns the flag location of the error message with the given id E
130
 
131
   -----------------------------------
132
   -- Error Message Data Structures --
133
   -----------------------------------
134
 
135
   --  The error messages are stored as a linked list of error message objects
136
   --  sorted into ascending order by the source location (Sloc). Each object
137
   --  records the text of the message and its source location.
138
 
139
   --  The following record type and table are used to represent error
140
   --  messages, with one entry in the table being allocated for each message.
141
 
142
   type Error_Msg_Object is record
143
      Text : String_Ptr;
144
      --  Text of error message, fully expanded with all insertions
145
 
146
      Next : Error_Msg_Id;
147
      --  Pointer to next message in error chain. A value of No_Error_Msg
148
      --  indicates the end of the chain.
149
 
150
      Prev : Error_Msg_Id;
151
      --  Pointer to previous message in error chain. Only set during the
152
      --  Finalize procedure. A value of No_Error_Msg indicates the first
153
      --  message in the chain.
154
 
155
      Sfile : Source_File_Index;
156
      --  Source table index of source file. In the case of an error that
157
      --  refers to a template, always references the original template
158
      --  not an instantiation copy.
159
 
160
      Sptr : Source_Ptr;
161
      --  Flag pointer. In the case of an error that refers to a template,
162
      --  always references the original template, not an instantiation copy.
163
      --  This value is the actual place in the source that the error message
164
      --  will be posted. Note that an error placed on an instantiation will
165
      --  have Sptr pointing to the instantiation point.
166
 
167
      Optr : Source_Ptr;
168
      --  Flag location used in the call to post the error. This is normally
169
      --  the same as Sptr, except when an error is posted on a particular
170
      --  instantiation of a generic. In such a case, Sptr will point to
171
      --  the original source location of the instantiation itself, but
172
      --  Optr will point to the template location (more accurately to the
173
      --  template copy in the instantiation copy corresponding to the
174
      --  instantiation referenced by Sptr).
175
 
176
      Line : Physical_Line_Number;
177
      --  Line number for error message
178
 
179
      Col : Column_Number;
180
      --  Column number for error message
181
 
182
      Warn : Boolean;
183
      --  True if warning message (i.e. insertion character ? appeared)
184
 
185
      Style : Boolean;
186
      --  True if style message (starts with "(style)")
187
 
188
      Serious : Boolean;
189
      --  True if serious error message (not a warning and no | character)
190
 
191
      Uncond : Boolean;
192
      --  True if unconditional message (i.e. insertion character ! appeared)
193
 
194
      Msg_Cont : Boolean;
195
      --  This is used for logical messages that are composed of multiple
196
      --  individual messages. For messages that are not part of such a
197
      --  group, or that are the first message in such a group. Msg_Cont
198
      --  is set to False. For subsequent messages in a group, Msg_Cont
199
      --  is set to True. This is used to make sure that such a group of
200
      --  messages is either suppressed or retained as a group (e.g. in
201
      --  the circuit that deletes identical messages).
202
 
203
      Deleted : Boolean;
204
      --  If this flag is set, the message is not printed. This is used
205
      --  in the circuit for deleting duplicate/redundant error messages.
206
   end record;
207
 
208
   package Errors is new Table.Table (
209
     Table_Component_Type => Error_Msg_Object,
210
     Table_Index_Type     => Error_Msg_Id,
211
     Table_Low_Bound      => 1,
212
     Table_Initial        => 200,
213
     Table_Increment      => 200,
214
     Table_Name           => "Error");
215
 
216
   First_Error_Msg : Error_Msg_Id;
217
   --  The list of error messages, i.e. the first entry on the list of error
218
   --  messages. This is not the same as the physically first entry in the
219
   --  error message table, since messages are not always inserted in sequence.
220
 
221
   Last_Error_Msg : Error_Msg_Id;
222
   --  The last entry on the list of error messages. Note: this is not the same
223
   --  as the physically last entry in the error message table, since messages
224
   --  are not always inserted in sequence.
225
 
226
   --------------------------
227
   -- Warning Mode Control --
228
   --------------------------
229
 
230
   --  Pragma Warnings allows warnings to be turned off for a specified region
231
   --  of code, and the following tables are the data structures used to keep
232
   --  track of these regions.
233
 
234
   --  The first table is used for the basic command line control, and for the
235
   --  forms of Warning with a single ON or OFF parameter.
236
 
237
   --  It contains pairs of source locations, the first being the start
238
   --  location for a warnings off region, and the second being the end
239
   --  location. When a pragma Warnings (Off) is encountered, a new entry is
240
   --  established extending from the location of the pragma to the end of the
241
   --  current source file. A subsequent pragma Warnings (On) adjusts the end
242
   --  point of this entry appropriately.
243
 
244
   --  If all warnings are suppressed by command switch, then there is a dummy
245
   --  entry (put there by Errout.Initialize) at the start of the table which
246
   --  covers all possible Source_Ptr values. Note that the source pointer
247
   --  values in this table always reference the original template, not an
248
   --  instantiation copy, in the generic case.
249
 
250
   type Warnings_Entry is record
251
      Start : Source_Ptr;
252
      Stop  : Source_Ptr;
253
   end record;
254
 
255
   package Warnings is new Table.Table (
256
     Table_Component_Type => Warnings_Entry,
257
     Table_Index_Type     => Natural,
258
     Table_Low_Bound      => 1,
259
     Table_Initial        => 100,
260
     Table_Increment      => 200,
261
     Table_Name           => "Warnings");
262
 
263
   --  The second table is used for the specific forms of the pragma, where
264
   --  the first argument is ON or OFF, and the second parameter is a string
265
   --  which is the entire message to suppress, or a prefix of it.
266
 
267
   type Specific_Warning_Entry is record
268
      Start : Source_Ptr;
269
      Stop  : Source_Ptr;
270
      --  Starting and ending source pointers for the range. These are always
271
      --  from the same source file.
272
 
273
      Msg : String_Ptr;
274
      --  Message from pragma Warnings (Off, string)
275
 
276
      Open : Boolean;
277
      --  Set to True if OFF has been encountered with no matching ON
278
 
279
      Used : Boolean;
280
      --  Set to True if entry has been used to suppress a warning
281
 
282
      Config : Boolean;
283
      --  True if pragma is configuration pragma (in which case no matching Off
284
      --  pragma is required, and it is not required that a specific warning be
285
      --  suppressed).
286
   end record;
287
 
288
   package Specific_Warnings is new Table.Table (
289
     Table_Component_Type => Specific_Warning_Entry,
290
     Table_Index_Type     => Natural,
291
     Table_Low_Bound      => 1,
292
     Table_Initial        => 100,
293
     Table_Increment      => 200,
294
     Table_Name           => "Specific_Warnings");
295
 
296
   --  Note on handling configuration case versus specific case. A complication
297
   --  arises from this example:
298
 
299
   --     pragma Warnings (Off, "not referenced*");
300
   --     procedure Mumble (X : Integer) is
301
   --     pragma Warnings (On, "not referenced*");
302
   --     begin
303
   --        null;
304
   --     end Mumble;
305
 
306
   --  The trouble is that the first pragma is technically a configuration
307
   --  pragma, and yet it is clearly being used in the context of thinking of
308
   --  it as a specific case. To deal with this, what we do is that the On
309
   --  entry can match a configuration pragma from the same file, and if we
310
   --  find such an On entry, we cancel the indication of it being the
311
   --  configuration case. This seems to handle all cases we run into ok.
312
 
313
   -----------------
314
   -- Subprograms --
315
   -----------------
316
 
317
   procedure Add_Class;
318
   --  Add 'Class to buffer for class wide type case (Class_Flag set)
319
 
320
   function Buffer_Ends_With (S : String) return Boolean;
321
   --  Tests if message buffer ends with given string preceded by a space
322
 
323
   procedure Buffer_Remove (S : String);
324
   --  Removes given string from end of buffer if it is present
325
   --  at end of buffer, and preceded by a space.
326
 
327
   function Compilation_Errors return Boolean;
328
   --  Returns true if errors have been detected, or warnings in -gnatwe
329
   --  (treat warnings as errors) mode.
330
 
331
   procedure dmsg (Id : Error_Msg_Id);
332
   --  Debugging routine to dump an error message
333
 
334
   procedure Debug_Output (N : Node_Id);
335
   --  Called from Error_Msg_N and Error_Msg_NE to generate line of debug
336
   --  output giving node number (of node N) if the debug X switch is set.
337
 
338
   procedure Check_Duplicate_Message (M1, M2 : Error_Msg_Id);
339
   --  This function is passed the Id values of two error messages. If either
340
   --  M1 or M2 is a continuation message, or is already deleted, the call is
341
   --  ignored. Otherwise a check is made to see if M1 and M2 are duplicated or
342
   --  redundant. If so, the message to be deleted and all its continuations
343
   --  are marked with the Deleted flag set to True.
344
 
345
   procedure Output_Error_Msgs (E : in out Error_Msg_Id);
346
   --  Output source line, error flag, and text of stored error message and all
347
   --  subsequent messages for the same line and unit. On return E is set to be
348
   --  one higher than the last message output.
349
 
350
   procedure Output_Line_Number (L : Logical_Line_Number);
351
   --  Output a line number as six digits (with leading zeroes suppressed),
352
   --  followed by a period and a blank (note that this is 8 characters which
353
   --  means that tabs in the source line will not get messed up). Line numbers
354
   --  that match or are less than the last Source_Reference pragma are listed
355
   --  as all blanks, avoiding output of junk line numbers.
356
 
357
   procedure Output_Msg_Text (E : Error_Msg_Id);
358
   --  Outputs characters of text in the text of the error message E. Note that
359
   --  no end of line is output, the caller is responsible for adding the end
360
   --  of line. If Error_Msg_Line_Length is non-zero, this is the routine that
361
   --  splits the line generating multiple lines of output, and in this case
362
   --  the last line has no terminating end of line character.
363
 
364
   procedure Purge_Messages (From : Source_Ptr; To : Source_Ptr);
365
   --  All error messages whose location is in the range From .. To (not
366
   --  including the end points) will be deleted from the error listing.
367
 
368
   function Same_Error (M1, M2 : Error_Msg_Id) return Boolean;
369
   --  See if two messages have the same text. Returns true if the text of the
370
   --  two messages is identical, or if one of them is the same as the other
371
   --  with an appended "instance at xxx" tag.
372
 
373
   procedure Set_Msg_Blank;
374
   --  Sets a single blank in the message if the preceding character is a
375
   --  non-blank character other than a left parenthesis or minus. Has no
376
   --  effect if manual quote mode is turned on.
377
 
378
   procedure Set_Msg_Blank_Conditional;
379
   --  Sets a single blank in the message if the preceding character is a
380
   --  non-blank character other than a left parenthesis or quote. Has no
381
   --  effect if manual quote mode is turned on.
382
 
383
   procedure Set_Msg_Char (C : Character);
384
   --  Add a single character to the current message. This routine does not
385
   --  check for special insertion characters (they are just treated as text
386
   --  characters if they occur).
387
 
388
   procedure Set_Msg_Insertion_File_Name;
389
   --  Handle file name insertion (left brace insertion character)
390
 
391
   procedure Set_Msg_Insertion_Line_Number (Loc, Flag : Source_Ptr);
392
   --  Handle line number insertion (# insertion character). Loc is the
393
   --  location to be referenced, and Flag is the location at which the
394
   --  flag is posted (used to determine whether to add "in file xxx")
395
 
396
   procedure Set_Msg_Insertion_Name_Literal;
397
 
398
   procedure Set_Msg_Insertion_Name;
399
   --  Handle name insertion (% insertion character)
400
 
401
   procedure Set_Msg_Insertion_Reserved_Name;
402
   --  Handle insertion of reserved word name (* insertion character)
403
 
404
   procedure Set_Msg_Insertion_Reserved_Word
405
     (Text : String;
406
      J    : in out Integer);
407
   --  Handle reserved word insertion (upper case letters). The Text argument
408
   --  is the current error message input text, and J is an index which on
409
   --  entry points to the first character of the reserved word, and on exit
410
   --  points past the last character of the reserved word.
411
 
412
   procedure Set_Msg_Insertion_Run_Time_Name;
413
   --  If package System contains a definition for Run_Time_Name (see package
414
   --  Targparm for details), then this procedure will insert a message of
415
   --  the form (name) into the current error message, with name set in mixed
416
   --  case (upper case after any spaces). If no run time name is defined,
417
   --  then this routine has no effect).
418
 
419
   procedure Set_Msg_Insertion_Uint;
420
   --  Handle Uint insertion (^ insertion character)
421
 
422
   procedure Set_Msg_Int (Line : Int);
423
   --  Set the decimal representation of the argument in the error message
424
   --  buffer with no leading zeroes output.
425
 
426
   procedure Set_Msg_Name_Buffer;
427
   --  Output name from Name_Buffer, with surrounding quotes unless manual
428
   --  quotation mode is in effect.
429
 
430
   procedure Set_Msg_Quote;
431
   --  Set quote if in normal quote mode, nothing if in manual quote mode
432
 
433
   procedure Set_Msg_Str (Text : String);
434
   --  Add a sequence of characters to the current message. This routine does
435
   --  not check for special insertion characters (they are just treated as
436
   --  text characters if they occur).
437
 
438
   procedure Set_Next_Non_Deleted_Msg (E : in out Error_Msg_Id);
439
   --  Given a message id, move to next message id, but skip any deleted
440
   --  messages, so that this results in E on output being the first non-
441
   --  deleted message following the input value of E, or No_Error_Msg if
442
   --  the input value of E was either already No_Error_Msg, or was the
443
   --  last non-deleted message.
444
 
445
   procedure Set_Specific_Warning_Off
446
     (Loc    : Source_Ptr;
447
      Msg    : String;
448
      Config : Boolean;
449
      Used   : Boolean := False);
450
   --  This is called in response to the two argument form of pragma Warnings
451
   --  where the first argument is OFF, and the second argument is a string
452
   --  which identifies a specific warning to be suppressed. The first argument
453
   --  is the start of the suppression range, and the second argument is the
454
   --  string from the pragma. Loc is the location of the pragma (which is the
455
   --  start of the range to suppress). Config is True for the configuration
456
   --  pragma case (where there is no requirement for a matching OFF pragma).
457
   --  Used is set True to disable the check that the warning actually has
458
   --  has the effect of suppressing a warning.
459
 
460
   procedure Set_Specific_Warning_On
461
     (Loc : Source_Ptr;
462
      Msg : String;
463
      Err : out Boolean);
464
   --  This is called in response to the two argument form of pragma Warnings
465
   --  where the first argument is ON, and the second argument is a string
466
   --  which identifies a specific warning to be suppressed. The first argument
467
   --  is the end of the suppression range, and the second argument is the
468
   --  string from the pragma. Err is set to True on return to report the error
469
   --  of no matching Warnings Off pragma preceding this one.
470
 
471
   procedure Set_Warnings_Mode_Off (Loc : Source_Ptr);
472
   --  Called in response to a pragma Warnings (Off) to record the source
473
   --  location from which warnings are to be turned off.
474
 
475
   procedure Set_Warnings_Mode_On (Loc : Source_Ptr);
476
   --  Called in response to a pragma Warnings (On) to record the source
477
   --  location from which warnings are to be turned back on.
478
 
479
   procedure Test_Style_Warning_Serious_Msg (Msg : String);
480
   --  Sets Is_Warning_Msg true if Msg is a warning message (contains a
481
   --  question mark character), and False otherwise. Is_Style_Msg is set true
482
   --  if Msg is a style message (starts with "(style)". Sets Is_Serious_Error
483
   --  True unless the message is a warning or style/info message or contains
484
   --  the character | indicating a non-serious error message. Note that the
485
   --  call has no effect for continuation messages (those whose first
486
   --  character is '\').
487
 
488
   function Warnings_Suppressed (Loc : Source_Ptr) return Boolean;
489
   --  Determines if given location is covered by a warnings off suppression
490
   --  range in the warnings table (or is suppressed by compilation option,
491
   --  which generates a warning range for the whole source file). This routine
492
   --  only deals with the general ON/OFF case, not specific warnings. True
493
   --  is also returned if warnings are globally suppressed.
494
 
495
   function Warning_Specifically_Suppressed
496
     (Loc : Source_Ptr;
497
      Msg : String_Ptr) return Boolean;
498
   --  Determines if given message to be posted at given location is suppressed
499
   --  by specific ON/OFF Warnings pragmas specifying this particular message.
500
 
501
   type Error_Msg_Proc is
502
     access procedure (Msg : String; Flag_Location : Source_Ptr);
503
   procedure Validate_Specific_Warnings (Eproc : Error_Msg_Proc);
504
   --  Checks that specific warnings are consistent (for non-configuration
505
   --  case, properly closed, and used). The argument is a pointer to the
506
   --  Error_Msg procedure to be called if any inconsistencies are detected.
507
 
508
end Erroutc;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.