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