1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1998-2002 Free Software Foundation, Inc. --
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 2, 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 COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 with Ada
.Strings
.Unbounded
;
34 function ALI_File_Name
(Ada_File_Name
: String) return String;
35 -- Returns the ali file name corresponding to Ada_File_Name, using the
36 -- information provided in gnat.adc if it exists
38 procedure Create_Project_File
40 -- Open and parse a new project file
41 -- If the file Name could not be open or is not a valid project file
42 -- then a project file associated with the standard default directories
45 function Find_ALI_File
(Short_Name
: String) return String;
46 -- Returns the directory name for the file Short_Name
47 -- takes into account the obj_dir lines in the project file,
48 -- and the default paths for Gnat
50 function Find_Source_File
(Short_Name
: String) return String;
51 -- Returns the directory name for the file Short_Name
52 -- takes into account the src_dir lines in the project file,
53 -- and the default paths for Gnat
55 function Next_Src_Dir
return String;
56 -- Returns the next directory to visit to find related source files
57 -- If there are no more such directory, Length = 0
59 function Next_Obj_Dir
return String;
60 -- Returns the next directory to visit to find related ali files
61 -- If there are no more such directory, Length = 0
63 function Current_Obj_Dir
return String;
64 -- Returns the obj_dir which was returned by the last Next_Obj_Dir call
66 procedure Parse_Gnatls
67 (Gnatls_Src_Cache
: out Ada
.Strings
.Unbounded
.Unbounded_String
;
68 Gnatls_Obj_Cache
: out Ada
.Strings
.Unbounded
.Unbounded_String
);
69 -- Parse the output of Gnatls, to find the standard
70 -- directories for source files
72 procedure Reset_Src_Dir
;
73 -- Reset the iterator for Src_Dir
75 procedure Reset_Obj_Dir
;
76 -- Reset the iterator for Obj_Dir
82 type Declaration_Reference
is private;
83 Empty_Declaration
: constant Declaration_Reference
;
85 type File_Reference
is private;
86 Empty_File
: constant File_Reference
;
88 type Reference
is private;
89 Empty_Reference
: constant Reference
;
91 type File_Table
is limited private;
92 type Entity_Table
is limited private;
94 function Add_Declaration
95 (File_Ref
: File_Reference
;
99 Decl_Type
: Character)
100 return Declaration_Reference
;
101 -- Add a new declaration in the table and return the index to it.
102 -- Decl_Type is the type of the entity
105 (Declaration
: in out Declaration_Reference
;
109 File_Ref
: File_Reference
);
110 -- The parent declaration (Symbol in file File_Ref at position Line and
111 -- Column) information is added to Declaration.
113 procedure Add_To_Xref_File
115 File_Existed
: out Boolean;
116 Ref
: out File_Reference
;
117 Visited
: Boolean := True;
118 Emit_Warning
: Boolean := False;
119 Gnatchop_File
: String := "";
120 Gnatchop_Offset
: Integer := 0);
121 -- Add a new reference to a file in the table. Ref is used to return the
122 -- index in the table where this file is stored On exit, File_Existed is
123 -- True if the file was already in the table Visited is the value which
124 -- will be used in the table (if True, the file will not be returned by
125 -- Next_Unvisited_File). If Emit_Warning is True and the ali file does
126 -- not exist or does not have cross-referencing information, then a
127 -- warning will be emitted. Gnatchop_File is the name of the file that
128 -- File_Name was extracted from through a call to "gnatchop -r" (using
129 -- pragma Source_Reference). Gnatchop_Offset should be the index of the
130 -- first line of File_Name within the Gnatchop_File.
133 (File
: File_Reference
;
136 -- Add a new reference in a file, which the user has provided
137 -- on the command line. This is used for a optimized matching
140 procedure Add_Reference
141 (Declaration
: Declaration_Reference
;
142 File_Ref
: File_Reference
;
145 Ref_Type
: Character);
146 -- Add a new reference (Ref_Type = 'r'), body (Ref_Type = 'b') or
147 -- modification (Ref_Type = 'm') to an entity
149 type Compare_Result
is (LessThan
, Equal
, GreaterThan
);
150 function Compare
(Ref1
, Ref2
: Reference
) return Compare_Result
;
152 (Decl1
: Declaration_Reference
;
153 File2
: File_Reference
;
157 return Compare_Result
;
158 -- Compare two references
160 function First_Body
(Decl
: Declaration_Reference
) return Reference
;
161 function First_Declaration
return Declaration_Reference
;
162 function First_Modif
(Decl
: Declaration_Reference
) return Reference
;
163 function First_Reference
(Decl
: Declaration_Reference
) return Reference
;
164 -- Initialize the iterators
166 function Get_Column
(Decl
: Declaration_Reference
) return String;
167 function Get_Column
(Ref
: Reference
) return String;
169 function Get_Declaration
170 (File_Ref
: File_Reference
;
173 return Declaration_Reference
;
174 -- Returns reference to the declaration found in file File_Ref at the
175 -- given Line and Column
178 (Decl
: Declaration_Reference
)
179 return Declaration_Reference
;
180 -- Returns reference to Decl's parent declaration
182 function Get_Emit_Warning
(File
: File_Reference
) return Boolean;
183 -- Returns the Emit_Warning field of the structure
185 function Get_Gnatchop_File
186 (File
: File_Reference
;
187 With_Dir
: Boolean := False)
189 function Get_Gnatchop_File
191 With_Dir
: Boolean := False)
193 function Get_Gnatchop_File
194 (Decl
: Declaration_Reference
;
195 With_Dir
: Boolean := False)
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.
203 (Decl
: Declaration_Reference
;
204 With_Dir
: Boolean := False)
206 -- Extract column number or file name from reference
210 With_Dir
: Boolean := False)
212 pragma Inline
(Get_File
);
215 (File
: File_Reference
;
216 With_Dir
: Boolean := False;
217 Strip
: Natural := 0)
219 -- Returns the file name (and its directory if With_Dir is True or the
220 -- user has used the -f switch on the command line. If Strip is not 0,
221 -- then the last Strip-th "-..." substrings are removed first. For
222 -- instance, with Strip=2, a file name "parent-child1-child2-child3.ali"
223 -- would be returned as "parent-child1.ali". This is used when looking
224 -- for the ALI file to use for a package, since for separates with have
225 -- to use the parent's ALI. The null string is returned if there is no
228 function Get_File_Ref
(Ref
: Reference
) return File_Reference
;
229 function Get_Line
(Decl
: Declaration_Reference
) return String;
230 function Get_Line
(Ref
: Reference
) return String;
231 function Get_Symbol
(Decl
: Declaration_Reference
) return String;
232 function Get_Type
(Decl
: Declaration_Reference
) return Character;
233 -- Functions that return the content of a declaration
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
239 procedure Grep_Source_Files
;
240 -- Parse all the source files which have at least one reference, and
241 -- grep the appropriate lines so that we'll be able to display them.
242 -- This function should be called once all the .ali files have been
243 -- parsed, and only if the appropriate user switch has been used.
245 function Longest_File_Name
return Natural;
246 -- Returns the longest file name found
248 function Match
(Decl
: Declaration_Reference
) return Boolean;
249 -- Return True if the declaration matches
252 (File
: File_Reference
;
256 -- Returns True if File:Line:Column was given on the command line
259 function Next
(Decl
: Declaration_Reference
) return Declaration_Reference
;
260 function Next
(Ref
: Reference
) return Reference
;
261 -- Returns the next declaration, or Empty_Declaration
263 function Next_Unvisited_File
return File_Reference
;
264 -- Returns the next unvisited library file in the list
265 -- If there is no more unvisited file, return Empty_File
267 procedure Set_Default_Match
(Value
: Boolean);
268 -- Set the default value for match in declarations.
269 -- This is used so that if no file was provided in the
270 -- command line, then every file match
272 procedure Set_Directory
273 (File
: File_Reference
;
275 -- Set the directory for a file
277 procedure Set_Unvisited
(File_Ref
: in File_Reference
);
278 -- Set File_Ref as unvisited. So Next_Unvisited_File will return it.
281 type Project_File
(Src_Dir_Length
, Obj_Dir_Length
: Natural) is record
282 Src_Dir
: String (1 .. Src_Dir_Length
);
283 Src_Dir_Index
: Integer;
285 Obj_Dir
: String (1 .. Obj_Dir_Length
);
286 Obj_Dir_Index
: Integer;
287 Last_Obj_Dir_Start
: Natural;
290 type Project_File_Ptr
is access all Project_File
;
291 -- This is actually a list of all the directories to be searched,
292 -- either for source files or for library files
294 type String_Access
is access all String;
297 type Ref_In_File_Ptr
is access all Ref_In_File
;
299 type Ref_In_File
is record
302 Next
: Ref_In_File_Ptr
:= null;
306 type File_Reference
is access all File_Record
;
308 Empty_File
: constant File_Reference
:= null;
310 type File_Record
(File_Length
: Natural) is record
311 File
: String (1 .. File_Length
);
312 Dir
: String_Access
:= null;
313 Lines
: Ref_In_File_Ptr
:= null;
314 Visited
: Boolean := False;
315 Emit_Warning
: Boolean := False;
316 Gnatchop_File
: String_Access
:= null;
317 Gnatchop_Offset
: Integer := 0;
318 Next
: File_Reference
:= null;
320 -- Holds a reference to a source file, that was referenced in at least one
321 -- ALI file. Gnatchop_File will contain the name of the file that File was
322 -- extracted From. Gnatchop_Offset contains the index of the first line of
323 -- File within Gnatchop_File. These two fields are used to properly support
324 -- gnatchop files and pragma Source_Reference.
326 type Reference_Record
;
327 type Reference
is access all Reference_Record
;
329 Empty_Reference
: constant Reference
:= null;
331 type Reference_Record
is record
332 File
: File_Reference
;
335 Source_Line
: Ada
.Strings
.Unbounded
.Unbounded_String
;
336 Next
: Reference
:= null;
338 -- File is a reference to the Ada source file
339 -- Source_Line is the Line as it appears in the source file. This
340 -- field is only used when the switch is set on the command line
342 type Declaration_Record
;
343 type Declaration_Reference
is access all Declaration_Record
;
345 Empty_Declaration
: constant Declaration_Reference
:= null;
347 type Declaration_Record
(Symbol_Length
: Natural) is record
348 Symbol
: String (1 .. Symbol_Length
);
349 Decl
: aliased Reference_Record
;
350 Decl_Type
: Character;
351 Body_Ref
: Reference
:= null;
352 Ref_Ref
: Reference
:= null;
353 Modif_Ref
: Reference
:= null;
354 Match
: Boolean := False;
355 Par_Symbol
: Declaration_Reference
:= null;
356 Next
: Declaration_Reference
:= null;
359 type File_Table
is record
360 Table
: File_Reference
:= null;
361 Longest_Name
: Natural := 0;
364 type Entity_Table
is record
365 Table
: Declaration_Reference
:= null;
368 pragma Inline
(First_Body
);
369 pragma Inline
(First_Declaration
);
370 pragma Inline
(First_Modif
);
371 pragma Inline
(First_Reference
);
372 pragma Inline
(Get_Column
);
373 pragma Inline
(Get_Emit_Warning
);
374 pragma Inline
(Get_File
);
375 pragma Inline
(Get_File_Ref
);
376 pragma Inline
(Get_Line
);
377 pragma Inline
(Get_Symbol
);
378 pragma Inline
(Get_Type
);
379 pragma Inline
(Longest_File_Name
);
380 pragma Inline
(Next
);