OSDN Git Service

gcc/fortran/
[pf3gnuchains/gcc-fork.git] / gcc / ada / xr_tabls.ads
1 ------------------------------------------------------------------------------
2 --                                                                          --
3 --                         GNAT COMPILER COMPONENTS                         --
4 --                                                                          --
5 --                             X R  _ T A B L S                             --
6 --                                                                          --
7 --                                 S p e c                                  --
8 --                                                                          --
9 --          Copyright (C) 1998-2008, 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 --  We need comment here saying what this package is???
27
28 with GNAT.OS_Lib;
29
30 package Xr_Tabls is
31
32    -------------------
33    -- Project files --
34    -------------------
35
36    function ALI_File_Name (Ada_File_Name : String) return String;
37    --  Returns the ali file name corresponding to Ada_File_Name
38
39    procedure Create_Project_File (Name : String);
40    --  Open and parse a new project file. If the file Name could not be
41    --  opened or is not a valid project file, then a project file associated
42    --  with the standard default directories is returned
43
44    function Next_Obj_Dir return String;
45    --  Returns the next directory to visit to find related ali files
46    --  If there are no more such directories, returns a null string.
47
48    function Current_Obj_Dir return String;
49    --  Returns the obj_dir which was returned by the last Next_Obj_Dir call
50
51    procedure Reset_Obj_Dir;
52    --  Reset the iterator for Obj_Dir
53
54    ------------
55    -- Tables --
56    ------------
57
58    type Declaration_Reference is private;
59    Empty_Declaration : constant Declaration_Reference;
60
61    type Declaration_Array is array (Natural range <>) of Declaration_Reference;
62    type Declaration_Array_Access is access Declaration_Array;
63
64    type File_Reference is private;
65    Empty_File : constant File_Reference;
66
67    type Reference is private;
68    Empty_Reference : constant Reference;
69
70    type Reference_Array is array (Natural range <>) of Reference;
71    type Reference_Array_Access is access Reference_Array;
72
73    procedure Free (Arr : in out Reference_Array_Access);
74
75    function Add_Declaration
76      (File_Ref     : File_Reference;
77       Symbol       : String;
78       Line         : Natural;
79       Column       : Natural;
80       Decl_Type    : Character;
81       Remove_Only  : Boolean := False;
82       Symbol_Match : Boolean := True)
83       return         Declaration_Reference;
84    --  Add a new declaration in the table and return the index to it. Decl_Type
85    --  is the type of the entity Any previous instance of this entity in the
86    --  htable is removed. If Remove_Only is True, then any previous instance is
87    --  removed, but the new entity is never inserted. Symbol_Match should be
88    --  set to False if the name of the symbol doesn't match the pattern from
89    --  the command line. In that case, the entity will not be output by
90    --  gnatfind. If Symbol_Match is True, the entity will only be output if the
91    --  file name itself matches.
92
93    procedure Add_Parent
94      (Declaration : in out Declaration_Reference;
95       Symbol      : String;
96       Line        : Natural;
97       Column      : Natural;
98       File_Ref    : File_Reference);
99    --  The parent declaration (Symbol in file File_Ref at position Line and
100    --  Column) information is added to Declaration.
101
102    function Add_To_Xref_File
103      (File_Name       : String;
104       Visited         : Boolean := True;
105       Emit_Warning    : Boolean := False;
106       Gnatchop_File   : String  := "";
107       Gnatchop_Offset : Integer := 0)
108       return            File_Reference;
109    --  Add a new reference to a file in the table. Ref is used to return the
110    --  index in the table where this file is stored. Visited is the value which
111    --  will be used in the table (if True, the file will not be returned by
112    --  Next_Unvisited_File). If Emit_Warning is True and the ali file does
113    --  not exist or does not have cross-referencing information, then a
114    --  warning will be emitted. Gnatchop_File is the name of the file that
115    --  File_Name was extracted from through a call to "gnatchop -r" (using
116    --  pragma Source_Reference). Gnatchop_Offset should be the index of the
117    --  first line of File_Name within the Gnatchop_File.
118
119    procedure Add_Line
120      (File   : File_Reference;
121       Line   : Natural;
122       Column : Natural);
123    --  Add a new reference in a file, which the user has provided on the
124    --  command line. This is used for an optimized matching algorithm.
125
126    procedure Add_Reference
127      (Declaration   : Declaration_Reference;
128       File_Ref      : File_Reference;
129       Line          : Natural;
130       Column        : Natural;
131       Ref_Type      : Character;
132       Labels_As_Ref : Boolean);
133    --  Add a new reference (Ref_Type = 'r'), body (Ref_Type = 'b') or
134    --  modification (Ref_Type = 'm') to an entity. If Labels_As_Ref is True,
135    --  then the references to the entity after the end statements ("end Foo")
136    --  are counted as actual references. This means that the entity will never
137    --  be reported as unreferenced (for instance in the case of gnatxref -u).
138
139    function Get_Declarations
140      (Sorted : Boolean := True)
141       return   Declaration_Array_Access;
142    --  Return a sorted list of all the declarations in the application.
143    --  Freeing this array is the responsibility of the caller, however it
144    --  shouldn't free the actual contents of the array, which are pointers
145    --  to internal data
146
147    function References_Count
148      (Decl       : Declaration_Reference;
149       Get_Reads  : Boolean := False;
150       Get_Writes : Boolean := False;
151       Get_Bodies : Boolean := False)
152       return       Natural;
153    --  Return the number of references in Decl for the categories specified
154    --  by the Get_* parameters (read-only accesses, write accesses and bodies)
155
156    function Get_References
157      (Decl : Declaration_Reference;
158       Get_Reads  : Boolean := False;
159       Get_Writes : Boolean := False;
160       Get_Bodies : Boolean := False)
161       return       Reference_Array_Access;
162    --  Return a sorted list of all references to the entity in decl. The
163    --  parameters Get_* are used to specify what kind of references should be
164    --  merged and returned (read-only accesses, write accesses and bodies).
165
166    function Get_Column (Decl : Declaration_Reference) return String;
167    function Get_Column (Ref : Reference) return String;
168
169    function Get_Declaration
170      (File_Ref : File_Reference;
171       Line     : Natural;
172       Column   : Natural)
173       return     Declaration_Reference;
174    --  Returns reference to the declaration found in file File_Ref at the
175    --  given Line and Column
176
177    function Get_Parent
178      (Decl : Declaration_Reference)
179       return Declaration_Reference;
180    --  Returns reference to Decl's parent declaration
181
182    function Get_Emit_Warning (File : File_Reference) return Boolean;
183    --  Returns the Emit_Warning field of the structure
184
185    function Get_Gnatchop_File
186      (File     : File_Reference;
187       With_Dir : Boolean := False)
188       return     String;
189    function Get_Gnatchop_File
190      (Ref      : Reference;
191       With_Dir : Boolean := False)
192       return     String;
193    function Get_Gnatchop_File
194      (Decl     : Declaration_Reference;
195       With_Dir : Boolean := False)
196       return     String;
197    --  Return the name of the file that File was extracted from through a
198    --  call to "gnatchop -r". The file name for File is returned if File
199    --  was not extracted from such a file. The directory will be given only
200    --  if With_Dir is True.
201
202    function Get_File
203      (Decl     : Declaration_Reference;
204       With_Dir : Boolean := False) return String;
205    pragma Inline (Get_File);
206    --  Extract column number or file name from reference
207
208    function Get_File
209      (Ref      : Reference;
210       With_Dir : Boolean := False) return String;
211    pragma Inline (Get_File);
212
213    function Get_File
214      (File     : File_Reference;
215       With_Dir : Boolean := False;
216       Strip    : Natural := 0) return String;
217    --  Returns the file name (and its directory if With_Dir is True or the user
218    --  has used the -f switch on the command line. If Strip is not 0, then the
219    --  last Strip-th "-..." substrings are removed first. For instance, with
220    --  Strip=2, a file name "parent-child1-child2-child3.ali" would be returned
221    --  as "parent-child1.ali". This is used when looking for the ALI file to
222    --  use for a package, since for separates with have to use the parent's
223    --  ALI. The null string is returned if there is no such parent unit.
224    --
225    --  Note that this version of Get_File is not inlined
226
227    function Get_File_Ref (Ref : Reference)              return File_Reference;
228    function Get_Line     (Decl : Declaration_Reference) return String;
229    function Get_Line     (Ref : Reference)              return String;
230    function Get_Symbol   (Decl : Declaration_Reference) return String;
231    function Get_Type     (Decl : Declaration_Reference) return Character;
232    function Is_Parameter (Decl : Declaration_Reference) return Boolean;
233    --  Functions that return the contents of a declaration
234
235    function Get_Source_Line (Ref : Reference)              return String;
236    function Get_Source_Line (Decl : Declaration_Reference) return String;
237    --  Return the source line associated with the reference
238
239    procedure Grep_Source_Files;
240    --  Parse all the source files which have at least one reference, and grep
241    --  the appropriate source lines so that we'll be able to display them. This
242    --  function should be called once all the .ali files have been parsed, and
243    --  only if the appropriate user switch
244    --  has been used (gnatfind -s).
245    --
246    --  Note: To save memory, the strings for the source lines are shared. Thus
247    --  it is no longer possible to free the references, or we would free the
248    --  same chunk multiple times. It doesn't matter, though, since this is only
249    --  called once, prior to exiting gnatfind.
250
251    function Longest_File_Name return Natural;
252    --  Returns the longest file name found
253
254    function Match (Decl : Declaration_Reference) return Boolean;
255    --  Return True if the declaration matches
256
257    function Match
258      (File   : File_Reference;
259       Line   : Natural;
260       Column : Natural)
261       return   Boolean;
262    --  Returns True if File:Line:Column was given on the command line
263    --  by the user
264
265    function Next_Unvisited_File return File_Reference;
266    --  Returns the next unvisited library file in the list If there is no more
267    --  unvisited file, return Empty_File. Two calls to this subprogram will
268    --  return different files.
269
270    procedure Set_Default_Match (Value : Boolean);
271    --  Set the default value for match in declarations.
272    --  This is used so that if no file was provided in the
273    --  command line, then every file match
274
275    procedure Reset_Directory (File : File_Reference);
276    --  Reset the cached directory for file. Next time Get_File is called, the
277    --  directory will be recomputed.
278
279    procedure Set_Unvisited (File_Ref : File_Reference);
280    --  Set File_Ref as unvisited. So Next_Unvisited_File will return it
281
282    procedure Read_File
283      (File_Name : String;
284       Contents  : out GNAT.OS_Lib.String_Access);
285    --  Reads File_Name into the newly allocated string Contents. Types.EOF
286    --  character will be added to the returned Contents to simplify parsing.
287    --  Name_Error is raised if the file was not found. End_Error is raised if
288    --  the file could not be read correctly. For most systems correct reading
289    --  means that the number of bytes read is equal to the file size. The
290    --  exception is OpenVMS where correct reading means that the number of
291    --  bytes read is less than or equal to the file size.
292
293 private
294    type Project_File (Src_Dir_Length, Obj_Dir_Length : Natural) is record
295       Src_Dir : String (1 .. Src_Dir_Length);
296       Src_Dir_Index : Integer;
297
298       Obj_Dir            : String (1 .. Obj_Dir_Length);
299       Obj_Dir_Index      : Integer;
300       Last_Obj_Dir_Start : Natural;
301    end record;
302
303    type Project_File_Ptr is access all Project_File;
304    --  This is actually a list of all the directories to be searched,
305    --  either for source files or for library files
306
307    type Ref_In_File;
308    type Ref_In_File_Ptr is access all Ref_In_File;
309
310    type Ref_In_File is record
311       Line   : Natural;
312       Column : Natural;
313       Next   : Ref_In_File_Ptr := null;
314    end record;
315
316    type File_Record;
317    type File_Reference is access all File_Record;
318
319    Empty_File : constant File_Reference := null;
320    type Cst_String_Access is access constant String;
321
322    procedure Free (Str : in out Cst_String_Access);
323
324    type File_Record is record
325       File            : Cst_String_Access;
326       Dir             : GNAT.OS_Lib.String_Access;
327       Lines           : Ref_In_File_Ptr := null;
328       Visited         : Boolean         := False;
329       Emit_Warning    : Boolean         := False;
330       Gnatchop_File   : GNAT.OS_Lib.String_Access   := null;
331       Gnatchop_Offset : Integer         := 0;
332       Next            : File_Reference  := null;
333    end record;
334    --  Holds a reference to a source file, that was referenced in at least one
335    --  ALI file. Gnatchop_File will contain the name of the file that File was
336    --  extracted From. Gnatchop_Offset contains the index of the first line of
337    --  File within Gnatchop_File. These two fields are used to properly support
338    --  gnatchop files and pragma Source_Reference.
339    --
340    --  Lines is used for files that were given on the command line, to
341    --  memorize the lines and columns that the user specified.
342
343    type Reference_Record;
344    type Reference is access all Reference_Record;
345
346    Empty_Reference : constant Reference := null;
347
348    type Reference_Record is record
349       File        : File_Reference;
350       Line        : Natural;
351       Column      : Natural;
352       Source_Line : Cst_String_Access;
353       Next        : Reference := null;
354    end record;
355    --  File is a reference to the Ada source file
356    --  Source_Line is the Line as it appears in the source file. This
357    --  field is only used when the switch is set on the command line of
358    --  gnatfind.
359
360    type Declaration_Record;
361    type Declaration_Reference is access all Declaration_Record;
362
363    Empty_Declaration : constant Declaration_Reference := null;
364
365    type Declaration_Record (Symbol_Length : Natural) is record
366       Key          : Cst_String_Access;
367       Symbol       : String (1 .. Symbol_Length);
368       Decl         : Reference;
369       Is_Parameter : Boolean := False; -- True if entity is subprog param
370       Decl_Type    : Character;
371       Body_Ref     : Reference := null;
372       Ref_Ref      : Reference := null;
373       Modif_Ref    : Reference := null;
374       Match        : Boolean := False;
375       Par_Symbol   : Declaration_Reference := null;
376       Next         : Declaration_Reference := null;
377    end record;
378    --  The lists of referenced (Body_Ref, Ref_Ref and Modif_Ref) are
379    --  kept unsorted until the results needs to be printed. This saves
380    --  lots of time while the internal tables are created.
381
382    pragma Inline (Get_Column);
383    pragma Inline (Get_Emit_Warning);
384    pragma Inline (Get_File_Ref);
385    pragma Inline (Get_Line);
386    pragma Inline (Get_Symbol);
387    pragma Inline (Get_Type);
388    pragma Inline (Longest_File_Name);
389 end Xr_Tabls;