1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
10 -- Copyright (C) 1998-2002 Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). --
25 ------------------------------------------------------------------------------
27 with Ada
.Strings
.Unbounded
;
35 function ALI_File_Name
(Ada_File_Name
: String) return String;
36 -- Returns the ali file name corresponding to Ada_File_Name, using the
37 -- information provided in gnat.adc if it exists
39 procedure Create_Project_File
41 -- Open and parse a new project file
42 -- If the file Name could not be open or is not a valid project file
43 -- then a project file associated with the standard default directories
46 function Find_ALI_File
(Short_Name
: String) return String;
47 -- Returns the directory name for the file Short_Name
48 -- takes into account the obj_dir lines in the project file,
49 -- and the default paths for Gnat
51 function Find_Source_File
(Short_Name
: String) return String;
52 -- Returns the directory name for the file Short_Name
53 -- takes into account the src_dir lines in the project file,
54 -- and the default paths for Gnat
56 function Next_Src_Dir
return String;
57 -- Returns the next directory to visit to find related source files
58 -- If there are no more such directory, Length = 0
60 function Next_Obj_Dir
return String;
61 -- Returns the next directory to visit to find related ali files
62 -- If there are no more such directory, Length = 0
64 function Current_Obj_Dir
return String;
65 -- Returns the obj_dir which was returned by the last Next_Obj_Dir call
67 procedure Parse_Gnatls
68 (Gnatls_Src_Cache
: out Ada
.Strings
.Unbounded
.Unbounded_String
;
69 Gnatls_Obj_Cache
: out Ada
.Strings
.Unbounded
.Unbounded_String
);
70 -- Parse the output of Gnatls, to find the standard
71 -- directories for source files
73 procedure Reset_Src_Dir
;
74 -- Reset the iterator for Src_Dir
76 procedure Reset_Obj_Dir
;
77 -- Reset the iterator for Obj_Dir
83 type Declaration_Reference
is private;
84 Empty_Declaration
: constant Declaration_Reference
;
86 type File_Reference
is private;
87 Empty_File
: constant File_Reference
;
89 type Reference
is private;
90 Empty_Reference
: constant Reference
;
92 type File_Table
is limited private;
93 type Entity_Table
is limited private;
95 function Add_Declaration
96 (File_Ref
: File_Reference
;
100 Decl_Type
: Character)
101 return Declaration_Reference
;
102 -- Add a new declaration in the table and return the index to it.
103 -- Decl_Type is the type of the entity
106 (Declaration
: in out Declaration_Reference
;
110 File_Ref
: File_Reference
);
111 -- The parent declaration (Symbol in file File_Ref at position Line and
112 -- Column) information is added to Declaration.
114 procedure Add_To_Xref_File
116 File_Existed
: out Boolean;
117 Ref
: out File_Reference
;
118 Visited
: Boolean := True;
119 Emit_Warning
: Boolean := False;
120 Gnatchop_File
: String := "";
121 Gnatchop_Offset
: Integer := 0);
122 -- Add a new reference to a file in the table. Ref is used to return the
123 -- index in the table where this file is stored On exit, File_Existed is
124 -- True if the file was already in the table Visited is the value which
125 -- will be used in the table (if True, the file will not be returned by
126 -- Next_Unvisited_File). If Emit_Warning is True and the ali file does
127 -- not exist or does not have cross-referencing information, then a
128 -- warning will be emitted. Gnatchop_File is the name of the file that
129 -- File_Name was extracted from through a call to "gnatchop -r" (using
130 -- pragma Source_Reference). Gnatchop_Offset should be the index of the
131 -- first line of File_Name within the Gnatchop_File.
134 (File
: File_Reference
;
137 -- Add a new reference in a file, which the user has provided
138 -- on the command line. This is used for a optimized matching
141 procedure Add_Reference
142 (Declaration
: Declaration_Reference
;
143 File_Ref
: File_Reference
;
146 Ref_Type
: Character);
147 -- Add a new reference (Ref_Type = 'r'), body (Ref_Type = 'b') or
148 -- modification (Ref_Type = 'm') to an entity
150 type Compare_Result
is (LessThan
, Equal
, GreaterThan
);
151 function Compare
(Ref1
, Ref2
: Reference
) return Compare_Result
;
153 (Decl1
: Declaration_Reference
;
154 File2
: File_Reference
;
158 return Compare_Result
;
159 -- Compare two references
161 function First_Body
(Decl
: Declaration_Reference
) return Reference
;
162 function First_Declaration
return Declaration_Reference
;
163 function First_Modif
(Decl
: Declaration_Reference
) return Reference
;
164 function First_Reference
(Decl
: Declaration_Reference
) return Reference
;
165 -- Initialize the iterators
167 function Get_Column
(Decl
: Declaration_Reference
) return String;
168 function Get_Column
(Ref
: Reference
) return String;
170 function Get_Declaration
171 (File_Ref
: File_Reference
;
174 return Declaration_Reference
;
175 -- Returns reference to the declaration found in file File_Ref at the
176 -- given Line and Column
179 (Decl
: Declaration_Reference
)
180 return Declaration_Reference
;
181 -- Returns reference to Decl's parent declaration
183 function Get_Emit_Warning
(File
: File_Reference
) return Boolean;
184 -- Returns the Emit_Warning field of the structure
186 function Get_Gnatchop_File
187 (File
: File_Reference
;
188 With_Dir
: Boolean := False)
190 function Get_Gnatchop_File
192 With_Dir
: Boolean := False)
194 function Get_Gnatchop_File
195 (Decl
: Declaration_Reference
;
196 With_Dir
: Boolean := False)
198 -- Return the name of the file that File was extracted from through a
199 -- call to "gnatchop -r". The file name for File is returned if File
200 -- was not extracted from such a file. The directory will be given only
201 -- if With_Dir is True.
204 (Decl
: Declaration_Reference
;
205 With_Dir
: Boolean := False)
207 -- Extract column number or file name from reference
211 With_Dir
: Boolean := False)
213 pragma Inline
(Get_File
);
216 (File
: File_Reference
;
217 With_Dir
: Boolean := False;
218 Strip
: Natural := 0)
220 -- Returns the file name (and its directory if With_Dir is True or the
221 -- user has used the -f switch on the command line. If Strip is not 0,
222 -- then the last Strip-th "-..." substrings are removed first. For
223 -- instance, with Strip=2, a file name "parent-child1-child2-child3.ali"
224 -- would be returned as "parent-child1.ali". This is used when looking
225 -- for the ALI file to use for a package, since for separates with have
226 -- to use the parent's ALI. The null string is returned if there is no
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 -- Functions that return the content of a declaration
236 function Get_Source_Line
(Ref
: Reference
) return String;
237 function Get_Source_Line
(Decl
: Declaration_Reference
) return String;
238 -- Return the source line associated with the reference
240 procedure Grep_Source_Files
;
241 -- Parse all the source files which have at least one reference, and
242 -- grep the appropriate lines so that we'll be able to display them.
243 -- This function should be called once all the .ali files have been
244 -- parsed, and only if the appropriate user switch has been used.
246 function Longest_File_Name
return Natural;
247 -- Returns the longest file name found
249 function Match
(Decl
: Declaration_Reference
) return Boolean;
250 -- Return True if the declaration matches
253 (File
: File_Reference
;
257 -- Returns True if File:Line:Column was given on the command line
260 function Next
(Decl
: Declaration_Reference
) return Declaration_Reference
;
261 function Next
(Ref
: Reference
) return Reference
;
262 -- Returns the next declaration, or Empty_Declaration
264 function Next_Unvisited_File
return File_Reference
;
265 -- Returns the next unvisited library file in the list
266 -- If there is no more unvisited file, return Empty_File
268 procedure Set_Default_Match
(Value
: Boolean);
269 -- Set the default value for match in declarations.
270 -- This is used so that if no file was provided in the
271 -- command line, then every file match
273 procedure Set_Directory
274 (File
: File_Reference
;
276 -- Set the directory for a file
278 procedure Set_Unvisited
(File_Ref
: in File_Reference
);
279 -- Set File_Ref as unvisited. So Next_Unvisited_File will return it.
282 type Project_File
(Src_Dir_Length
, Obj_Dir_Length
: Natural) is record
283 Src_Dir
: String (1 .. Src_Dir_Length
);
284 Src_Dir_Index
: Integer;
286 Obj_Dir
: String (1 .. Obj_Dir_Length
);
287 Obj_Dir_Index
: Integer;
288 Last_Obj_Dir_Start
: Natural;
291 type Project_File_Ptr
is access all Project_File
;
292 -- This is actually a list of all the directories to be searched,
293 -- either for source files or for library files
295 type String_Access
is access all String;
298 type Ref_In_File_Ptr
is access all Ref_In_File
;
300 type Ref_In_File
is record
303 Next
: Ref_In_File_Ptr
:= null;
307 type File_Reference
is access all File_Record
;
309 Empty_File
: constant File_Reference
:= null;
311 type File_Record
(File_Length
: Natural) is record
312 File
: String (1 .. File_Length
);
313 Dir
: String_Access
:= null;
314 Lines
: Ref_In_File_Ptr
:= null;
315 Visited
: Boolean := False;
316 Emit_Warning
: Boolean := False;
317 Gnatchop_File
: String_Access
:= null;
318 Gnatchop_Offset
: Integer := 0;
319 Next
: File_Reference
:= null;
321 -- Holds a reference to a source file, that was referenced in at least one
322 -- ALI file. Gnatchop_File will contain the name of the file that File was
323 -- extracted From. Gnatchop_Offset contains the index of the first line of
324 -- File within Gnatchop_File. These two fields are used to properly support
325 -- gnatchop files and pragma Source_Reference.
327 type Reference_Record
;
328 type Reference
is access all Reference_Record
;
330 Empty_Reference
: constant Reference
:= null;
332 type Reference_Record
is record
333 File
: File_Reference
;
336 Source_Line
: Ada
.Strings
.Unbounded
.Unbounded_String
;
337 Next
: Reference
:= null;
339 -- File is a reference to the Ada source file
340 -- Source_Line is the Line as it appears in the source file. This
341 -- field is only used when the switch is set on the command line
343 type Declaration_Record
;
344 type Declaration_Reference
is access all Declaration_Record
;
346 Empty_Declaration
: constant Declaration_Reference
:= null;
348 type Declaration_Record
(Symbol_Length
: Natural) is record
349 Symbol
: String (1 .. Symbol_Length
);
350 Decl
: aliased Reference_Record
;
351 Decl_Type
: Character;
352 Body_Ref
: Reference
:= null;
353 Ref_Ref
: Reference
:= null;
354 Modif_Ref
: Reference
:= null;
355 Match
: Boolean := False;
356 Par_Symbol
: Declaration_Reference
:= null;
357 Next
: Declaration_Reference
:= null;
360 type File_Table
is record
361 Table
: File_Reference
:= null;
362 Longest_Name
: Natural := 0;
365 type Entity_Table
is record
366 Table
: Declaration_Reference
:= null;
369 pragma Inline
(First_Body
);
370 pragma Inline
(First_Declaration
);
371 pragma Inline
(First_Modif
);
372 pragma Inline
(First_Reference
);
373 pragma Inline
(Get_Column
);
374 pragma Inline
(Get_Emit_Warning
);
375 pragma Inline
(Get_File
);
376 pragma Inline
(Get_File_Ref
);
377 pragma Inline
(Get_Line
);
378 pragma Inline
(Get_Symbol
);
379 pragma Inline
(Get_Type
);
380 pragma Inline
(Longest_File_Name
);
381 pragma Inline
(Next
);