|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT COMPILER COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- X R E F _ L I B --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
|
9 -- Copyright (C) 1998-2017, 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 with Osint;
|
|
|
27 with Output; use Output;
|
|
|
28 with Types; use Types;
|
|
|
29
|
|
|
30 with Unchecked_Deallocation;
|
|
|
31
|
|
|
32 with Ada.Strings.Fixed; use Ada.Strings.Fixed;
|
|
|
33 with Ada.Text_IO;
|
|
|
34
|
|
|
35 with GNAT.Command_Line; use GNAT.Command_Line;
|
|
|
36 with GNAT.IO_Aux; use GNAT.IO_Aux;
|
|
|
37
|
|
|
38 package body Xref_Lib is
|
|
|
39
|
|
|
40 Type_Position : constant := 50;
|
|
|
41 -- Column for label identifying type of entity
|
|
|
42
|
|
|
43 ---------------------
|
|
|
44 -- Local Variables --
|
|
|
45 ---------------------
|
|
|
46
|
|
|
47 Pipe : constant Character := '|';
|
|
|
48 -- First character on xref lines in the .ali file
|
|
|
49
|
|
|
50 No_Xref_Information : exception;
|
|
|
51 -- Exception raised when there is no cross-referencing information in
|
|
|
52 -- the .ali files.
|
|
|
53
|
|
|
54 procedure Parse_EOL
|
|
|
55 (Source : not null access String;
|
|
|
56 Ptr : in out Positive;
|
|
|
57 Skip_Continuation_Line : Boolean := False);
|
|
|
58 -- On return Source (Ptr) is the first character of the next line
|
|
|
59 -- or EOF. Source.all must be terminated by EOF.
|
|
|
60 --
|
|
|
61 -- If Skip_Continuation_Line is True, this subprogram skips as many
|
|
|
62 -- lines as required when the second or more lines starts with '.'
|
|
|
63 -- (continuation lines in ALI files).
|
|
|
64
|
|
|
65 function Current_Xref_File (File : ALI_File) return File_Reference;
|
|
|
66 -- Return the file matching the last 'X' line we found while parsing
|
|
|
67 -- the ALI file.
|
|
|
68
|
|
|
69 function File_Name (File : ALI_File; Num : Positive) return File_Reference;
|
|
|
70 -- Returns the dependency file name number Num
|
|
|
71
|
|
|
72 function Get_Full_Type (Decl : Declaration_Reference) return String;
|
|
|
73 -- Returns the full type corresponding to a type letter as found in
|
|
|
74 -- the .ali files.
|
|
|
75
|
|
|
76 procedure Open
|
|
|
77 (Name : String;
|
|
|
78 File : out ALI_File;
|
|
|
79 Dependencies : Boolean := False);
|
|
|
80 -- Open a new ALI file. If Dependencies is True, the insert every library
|
|
|
81 -- file 'with'ed in the files database (used for gnatxref)
|
|
|
82
|
|
|
83 procedure Parse_Identifier_Info
|
|
|
84 (Pattern : Search_Pattern;
|
|
|
85 File : in out ALI_File;
|
|
|
86 Local_Symbols : Boolean;
|
|
|
87 Der_Info : Boolean := False;
|
|
|
88 Type_Tree : Boolean := False;
|
|
|
89 Wide_Search : Boolean := True;
|
|
|
90 Labels_As_Ref : Boolean := True);
|
|
|
91 -- Output the file and the line where the identifier was referenced,
|
|
|
92 -- If Local_Symbols is False then only the publicly visible symbols
|
|
|
93 -- will be processed.
|
|
|
94 --
|
|
|
95 -- If Labels_As_Ref is true, then the references to the entities after
|
|
|
96 -- the end statements ("end Foo") will be counted as actual references.
|
|
|
97 -- The entity will never be reported as unreferenced by gnatxref -u
|
|
|
98
|
|
|
99 procedure Parse_Token
|
|
|
100 (Source : not null access String;
|
|
|
101 Ptr : in out Positive;
|
|
|
102 Token_Ptr : out Positive);
|
|
|
103 -- Skips any separators and stores the start of the token in Token_Ptr.
|
|
|
104 -- Then stores the position of the next separator in Ptr. On return
|
|
|
105 -- Source (Token_Ptr .. Ptr - 1) is the token. Separators are space
|
|
|
106 -- and ASCII.HT. Parse_Token will never skip to the next line.
|
|
|
107
|
|
|
108 procedure Parse_Number
|
|
|
109 (Source : not null access String;
|
|
|
110 Ptr : in out Positive;
|
|
|
111 Number : out Natural);
|
|
|
112 -- Skips any separators and parses Source up to the first character that
|
|
|
113 -- is not a decimal digit. Returns value of parsed digits or 0 if none.
|
|
|
114
|
|
|
115 procedure Parse_X_Filename (File : in out ALI_File);
|
|
|
116 -- Reads and processes "X..." lines in the ALI file
|
|
|
117 -- and updates the File.X_File information.
|
|
|
118
|
|
|
119 procedure Skip_To_First_X_Line
|
|
|
120 (File : in out ALI_File;
|
|
|
121 D_Lines : Boolean;
|
|
|
122 W_Lines : Boolean);
|
|
|
123 -- Skip the lines in the ALI file until the first cross-reference line
|
|
|
124 -- (^X...) is found. Search is started from the beginning of the file.
|
|
|
125 -- If not such line is found, No_Xref_Information is raised.
|
|
|
126 -- If W_Lines is false, then the lines "^W" are not parsed.
|
|
|
127 -- If D_Lines is false, then the lines "^D" are not parsed.
|
|
|
128
|
|
|
129 ----------------
|
|
|
130 -- Add_Entity --
|
|
|
131 ----------------
|
|
|
132
|
|
|
133 procedure Add_Entity
|
|
|
134 (Pattern : in out Search_Pattern;
|
|
|
135 Entity : String;
|
|
|
136 Glob : Boolean := False)
|
|
|
137 is
|
|
|
138 File_Start : Natural;
|
|
|
139 Line_Start : Natural;
|
|
|
140 Col_Start : Natural;
|
|
|
141 Line_Num : Natural := 0;
|
|
|
142 Col_Num : Natural := 0;
|
|
|
143
|
|
|
144 File_Ref : File_Reference := Empty_File;
|
|
|
145 pragma Warnings (Off, File_Ref);
|
|
|
146
|
|
|
147 begin
|
|
|
148 -- Find the end of the first item in Entity (pattern or file?)
|
|
|
149 -- If there is no ':', we only have a pattern
|
|
|
150
|
|
|
151 File_Start := Index (Entity, ":");
|
|
|
152
|
|
|
153 -- If the regular expression is invalid, just consider it as a string
|
|
|
154
|
|
|
155 if File_Start = 0 then
|
|
|
156 begin
|
|
|
157 Pattern.Entity := Compile (Entity, Glob, False);
|
|
|
158 Pattern.Initialized := True;
|
|
|
159
|
|
|
160 exception
|
|
|
161 when Error_In_Regexp =>
|
|
|
162
|
|
|
163 -- The basic idea is to insert a \ before every character
|
|
|
164
|
|
|
165 declare
|
|
|
166 Tmp_Regexp : String (1 .. 2 * Entity'Length);
|
|
|
167 Index : Positive := 1;
|
|
|
168
|
|
|
169 begin
|
|
|
170 for J in Entity'Range loop
|
|
|
171 Tmp_Regexp (Index) := '\';
|
|
|
172 Tmp_Regexp (Index + 1) := Entity (J);
|
|
|
173 Index := Index + 2;
|
|
|
174 end loop;
|
|
|
175
|
|
|
176 Pattern.Entity := Compile (Tmp_Regexp, True, False);
|
|
|
177 Pattern.Initialized := True;
|
|
|
178 end;
|
|
|
179 end;
|
|
|
180
|
|
|
181 Set_Default_Match (True);
|
|
|
182 return;
|
|
|
183 end if;
|
|
|
184
|
|
|
185 -- If there is a dot in the pattern, then it is a file name
|
|
|
186
|
|
|
187 if (Glob and then
|
|
|
188 Index (Entity (Entity'First .. File_Start - 1), ".") /= 0)
|
|
|
189 or else
|
|
|
190 (not Glob
|
|
|
191 and then Index (Entity (Entity'First .. File_Start - 1),
|
|
|
192 "\.") /= 0)
|
|
|
193 then
|
|
|
194 Pattern.Entity := Compile (".*", False);
|
|
|
195 Pattern.Initialized := True;
|
|
|
196 File_Start := Entity'First;
|
|
|
197
|
|
|
198 else
|
|
|
199 -- If the regular expression is invalid, just consider it as a string
|
|
|
200
|
|
|
201 begin
|
|
|
202 Pattern.Entity :=
|
|
|
203 Compile (Entity (Entity'First .. File_Start - 1), Glob, False);
|
|
|
204 Pattern.Initialized := True;
|
|
|
205
|
|
|
206 exception
|
|
|
207 when Error_In_Regexp =>
|
|
|
208
|
|
|
209 -- The basic idea is to insert a \ before every character
|
|
|
210
|
|
|
211 declare
|
|
|
212 Tmp_Regexp : String (1 .. 2 * (File_Start - Entity'First));
|
|
|
213 Index : Positive := 1;
|
|
|
214
|
|
|
215 begin
|
|
|
216 for J in Entity'First .. File_Start - 1 loop
|
|
|
217 Tmp_Regexp (Index) := '\';
|
|
|
218 Tmp_Regexp (Index + 1) := Entity (J);
|
|
|
219 Index := Index + 2;
|
|
|
220 end loop;
|
|
|
221
|
|
|
222 Pattern.Entity := Compile (Tmp_Regexp, True, False);
|
|
|
223 Pattern.Initialized := True;
|
|
|
224 end;
|
|
|
225 end;
|
|
|
226
|
|
|
227 File_Start := File_Start + 1;
|
|
|
228 end if;
|
|
|
229
|
|
|
230 -- Parse the file name
|
|
|
231
|
|
|
232 Line_Start := Index (Entity (File_Start .. Entity'Last), ":");
|
|
|
233
|
|
|
234 -- Check if it was a disk:\directory item (for Windows)
|
|
|
235
|
|
|
236 if File_Start = Line_Start - 1
|
|
|
237 and then Line_Start < Entity'Last
|
|
|
238 and then Entity (Line_Start + 1) = '\'
|
|
|
239 then
|
|
|
240 Line_Start := Index (Entity (Line_Start + 1 .. Entity'Last), ":");
|
|
|
241 end if;
|
|
|
242
|
|
|
243 if Line_Start = 0 then
|
|
|
244 Line_Start := Entity'Length + 1;
|
|
|
245
|
|
|
246 elsif Line_Start /= Entity'Last then
|
|
|
247 Col_Start := Index (Entity (Line_Start + 1 .. Entity'Last), ":");
|
|
|
248
|
|
|
249 if Col_Start = 0 then
|
|
|
250 Col_Start := Entity'Last + 1;
|
|
|
251 end if;
|
|
|
252
|
|
|
253 if Col_Start > Line_Start + 1 then
|
|
|
254 begin
|
|
|
255 Line_Num := Natural'Value
|
|
|
256 (Entity (Line_Start + 1 .. Col_Start - 1));
|
|
|
257
|
|
|
258 exception
|
|
|
259 when Constraint_Error =>
|
|
|
260 raise Invalid_Argument;
|
|
|
261 end;
|
|
|
262 end if;
|
|
|
263
|
|
|
264 if Col_Start < Entity'Last then
|
|
|
265 begin
|
|
|
266 Col_Num := Natural'Value (Entity
|
|
|
267 (Col_Start + 1 .. Entity'Last));
|
|
|
268
|
|
|
269 exception
|
|
|
270 when Constraint_Error => raise Invalid_Argument;
|
|
|
271 end;
|
|
|
272 end if;
|
|
|
273 end if;
|
|
|
274
|
|
|
275 declare
|
|
|
276 File_Name : String := Entity (File_Start .. Line_Start - 1);
|
|
|
277
|
|
|
278 begin
|
|
|
279 Osint.Canonical_Case_File_Name (File_Name);
|
|
|
280 File_Ref := Add_To_Xref_File (File_Name, Visited => True);
|
|
|
281 Pattern.File_Ref := File_Ref;
|
|
|
282
|
|
|
283 Add_Line (Pattern.File_Ref, Line_Num, Col_Num);
|
|
|
284
|
|
|
285 File_Ref :=
|
|
|
286 Add_To_Xref_File
|
|
|
287 (ALI_File_Name (File_Name),
|
|
|
288 Visited => False,
|
|
|
289 Emit_Warning => True);
|
|
|
290 end;
|
|
|
291 end Add_Entity;
|
|
|
292
|
|
|
293 -------------------
|
|
|
294 -- Add_Xref_File --
|
|
|
295 -------------------
|
|
|
296
|
|
|
297 procedure Add_Xref_File (File : String) is
|
|
|
298 File_Ref : File_Reference := Empty_File;
|
|
|
299 pragma Unreferenced (File_Ref);
|
|
|
300
|
|
|
301 Iterator : Expansion_Iterator;
|
|
|
302
|
|
|
303 procedure Add_Xref_File_Internal (File : String);
|
|
|
304 -- Do the actual addition of the file
|
|
|
305
|
|
|
306 ----------------------------
|
|
|
307 -- Add_Xref_File_Internal --
|
|
|
308 ----------------------------
|
|
|
309
|
|
|
310 procedure Add_Xref_File_Internal (File : String) is
|
|
|
311 begin
|
|
|
312 -- Case where we have an ALI file, accept it even though this is
|
|
|
313 -- not official usage, since the intention is obvious
|
|
|
314
|
|
|
315 if Tail (File, 4) = "." & Osint.ALI_Suffix.all then
|
|
|
316 File_Ref := Add_To_Xref_File
|
|
|
317 (File, Visited => False, Emit_Warning => True);
|
|
|
318
|
|
|
319 -- Normal non-ali file case
|
|
|
320
|
|
|
321 else
|
|
|
322 File_Ref := Add_To_Xref_File (File, Visited => True);
|
|
|
323
|
|
|
324 File_Ref := Add_To_Xref_File
|
|
|
325 (ALI_File_Name (File),
|
|
|
326 Visited => False, Emit_Warning => True);
|
|
|
327 end if;
|
|
|
328 end Add_Xref_File_Internal;
|
|
|
329
|
|
|
330 -- Start of processing for Add_Xref_File
|
|
|
331
|
|
|
332 begin
|
|
|
333 -- Check if we need to do the expansion
|
|
|
334
|
|
|
335 if Ada.Strings.Fixed.Index (File, "*") /= 0
|
|
|
336 or else Ada.Strings.Fixed.Index (File, "?") /= 0
|
|
|
337 then
|
|
|
338 Start_Expansion (Iterator, File);
|
|
|
339
|
|
|
340 loop
|
|
|
341 declare
|
|
|
342 S : constant String := Expansion (Iterator);
|
|
|
343
|
|
|
344 begin
|
|
|
345 exit when S'Length = 0;
|
|
|
346 Add_Xref_File_Internal (S);
|
|
|
347 end;
|
|
|
348 end loop;
|
|
|
349
|
|
|
350 else
|
|
|
351 Add_Xref_File_Internal (File);
|
|
|
352 end if;
|
|
|
353 end Add_Xref_File;
|
|
|
354
|
|
|
355 -----------------------
|
|
|
356 -- Current_Xref_File --
|
|
|
357 -----------------------
|
|
|
358
|
|
|
359 function Current_Xref_File (File : ALI_File) return File_Reference is
|
|
|
360 begin
|
|
|
361 return File.X_File;
|
|
|
362 end Current_Xref_File;
|
|
|
363
|
|
|
364 --------------------------
|
|
|
365 -- Default_Project_File --
|
|
|
366 --------------------------
|
|
|
367
|
|
|
368 function Default_Project_File (Dir_Name : String) return String is
|
|
|
369 My_Dir : Dir_Type;
|
|
|
370 Dir_Ent : File_Name_String;
|
|
|
371 Last : Natural;
|
|
|
372
|
|
|
373 begin
|
|
|
374 Open (My_Dir, Dir_Name);
|
|
|
375
|
|
|
376 loop
|
|
|
377 Read (My_Dir, Dir_Ent, Last);
|
|
|
378 exit when Last = 0;
|
|
|
379
|
|
|
380 if Tail (Dir_Ent (1 .. Last), 4) = ".adp" then
|
|
|
381
|
|
|
382 -- The first project file found is the good one
|
|
|
383
|
|
|
384 Close (My_Dir);
|
|
|
385 return Dir_Ent (1 .. Last);
|
|
|
386 end if;
|
|
|
387 end loop;
|
|
|
388
|
|
|
389 Close (My_Dir);
|
|
|
390 return String'(1 .. 0 => ' ');
|
|
|
391
|
|
|
392 exception
|
|
|
393 when Directory_Error => return String'(1 .. 0 => ' ');
|
|
|
394 end Default_Project_File;
|
|
|
395
|
|
|
396 ---------------
|
|
|
397 -- File_Name --
|
|
|
398 ---------------
|
|
|
399
|
|
|
400 function File_Name
|
|
|
401 (File : ALI_File;
|
|
|
402 Num : Positive) return File_Reference
|
|
|
403 is
|
|
|
404 Table : Table_Type renames File.Dep.Table (1 .. Last (File.Dep));
|
|
|
405 begin
|
|
|
406 return Table (Num);
|
|
|
407 end File_Name;
|
|
|
408
|
|
|
409 --------------------
|
|
|
410 -- Find_ALI_Files --
|
|
|
411 --------------------
|
|
|
412
|
|
|
413 procedure Find_ALI_Files is
|
|
|
414 My_Dir : Rec_DIR;
|
|
|
415 Dir_Ent : File_Name_String;
|
|
|
416 Last : Natural;
|
|
|
417
|
|
|
418 File_Ref : File_Reference;
|
|
|
419 pragma Unreferenced (File_Ref);
|
|
|
420
|
|
|
421 function Open_Next_Dir return Boolean;
|
|
|
422 -- Tries to open the next object directory, and return False if
|
|
|
423 -- the directory cannot be opened.
|
|
|
424
|
|
|
425 -------------------
|
|
|
426 -- Open_Next_Dir --
|
|
|
427 -------------------
|
|
|
428
|
|
|
429 function Open_Next_Dir return Boolean is
|
|
|
430 begin
|
|
|
431 -- Until we are able to open a new directory
|
|
|
432
|
|
|
433 loop
|
|
|
434 declare
|
|
|
435 Obj_Dir : constant String := Next_Obj_Dir;
|
|
|
436
|
|
|
437 begin
|
|
|
438 -- Case of no more Obj_Dir lines
|
|
|
439
|
|
|
440 if Obj_Dir'Length = 0 then
|
|
|
441 return False;
|
|
|
442 end if;
|
|
|
443
|
|
|
444 Open (My_Dir.Dir, Obj_Dir);
|
|
|
445 exit;
|
|
|
446
|
|
|
447 exception
|
|
|
448
|
|
|
449 -- Could not open the directory
|
|
|
450
|
|
|
451 when Directory_Error => null;
|
|
|
452 end;
|
|
|
453 end loop;
|
|
|
454
|
|
|
455 return True;
|
|
|
456 end Open_Next_Dir;
|
|
|
457
|
|
|
458 -- Start of processing for Find_ALI_Files
|
|
|
459
|
|
|
460 begin
|
|
|
461 Reset_Obj_Dir;
|
|
|
462
|
|
|
463 if Open_Next_Dir then
|
|
|
464 loop
|
|
|
465 Read (My_Dir.Dir, Dir_Ent, Last);
|
|
|
466
|
|
|
467 if Last = 0 then
|
|
|
468 Close (My_Dir.Dir);
|
|
|
469
|
|
|
470 if not Open_Next_Dir then
|
|
|
471 return;
|
|
|
472 end if;
|
|
|
473
|
|
|
474 elsif Last > 4
|
|
|
475 and then Dir_Ent (Last - 3 .. Last) = "." & Osint.ALI_Suffix.all
|
|
|
476 then
|
|
|
477 File_Ref :=
|
|
|
478 Add_To_Xref_File (Dir_Ent (1 .. Last), Visited => False);
|
|
|
479 end if;
|
|
|
480 end loop;
|
|
|
481 end if;
|
|
|
482 end Find_ALI_Files;
|
|
|
483
|
|
|
484 -------------------
|
|
|
485 -- Get_Full_Type --
|
|
|
486 -------------------
|
|
|
487
|
|
|
488 function Get_Full_Type (Decl : Declaration_Reference) return String is
|
|
|
489
|
|
|
490 function Param_String return String;
|
|
|
491 -- Return the string to display depending on whether Decl is a parameter
|
|
|
492
|
|
|
493 ------------------
|
|
|
494 -- Param_String --
|
|
|
495 ------------------
|
|
|
496
|
|
|
497 function Param_String return String is
|
|
|
498 begin
|
|
|
499 if Is_Parameter (Decl) then
|
|
|
500 return "parameter ";
|
|
|
501 else
|
|
|
502 return "";
|
|
|
503 end if;
|
|
|
504 end Param_String;
|
|
|
505
|
|
|
506 -- Start of processing for Get_Full_Type
|
|
|
507
|
|
|
508 begin
|
|
|
509 case Get_Type (Decl) is
|
|
|
510 when 'A' => return "array type";
|
|
|
511 when 'B' => return "boolean type";
|
|
|
512 when 'C' => return "class-wide type";
|
|
|
513 when 'D' => return "decimal type";
|
|
|
514 when 'E' => return "enumeration type";
|
|
|
515 when 'F' => return "float type";
|
|
|
516 when 'H' => return "abstract type";
|
|
|
517 when 'I' => return "integer type";
|
|
|
518 when 'M' => return "modular type";
|
|
|
519 when 'O' => return "fixed type";
|
|
|
520 when 'P' => return "access type";
|
|
|
521 when 'R' => return "record type";
|
|
|
522 when 'S' => return "string type";
|
|
|
523 when 'T' => return "task type";
|
|
|
524 when 'W' => return "protected type";
|
|
|
525
|
|
|
526 when 'a' => return Param_String & "array object";
|
|
|
527 when 'b' => return Param_String & "boolean object";
|
|
|
528 when 'c' => return Param_String & "class-wide object";
|
|
|
529 when 'd' => return Param_String & "decimal object";
|
|
|
530 when 'e' => return Param_String & "enumeration object";
|
|
|
531 when 'f' => return Param_String & "float object";
|
|
|
532 when 'i' => return Param_String & "integer object";
|
|
|
533 when 'j' => return Param_String & "class object";
|
|
|
534 when 'm' => return Param_String & "modular object";
|
|
|
535 when 'o' => return Param_String & "fixed object";
|
|
|
536 when 'p' => return Param_String & "access object";
|
|
|
537 when 'r' => return Param_String & "record object";
|
|
|
538 when 's' => return Param_String & "string object";
|
|
|
539 when 't' => return Param_String & "task object";
|
|
|
540 when 'w' => return Param_String & "protected object";
|
|
|
541 when 'x' => return Param_String & "abstract procedure";
|
|
|
542 when 'y' => return Param_String & "abstract function";
|
|
|
543
|
|
|
544 when 'h' => return "interface";
|
|
|
545 when 'g' => return "macro";
|
|
|
546 when 'G' => return "function macro";
|
|
|
547 when 'J' => return "class";
|
|
|
548 when 'K' => return "package";
|
|
|
549 when 'k' => return "generic package";
|
|
|
550 when 'L' => return "statement label";
|
|
|
551 when 'l' => return "loop label";
|
|
|
552 when 'N' => return "named number";
|
|
|
553 when 'n' => return "enumeration literal";
|
|
|
554 when 'q' => return "block label";
|
|
|
555 when 'Q' => return "include file";
|
|
|
556 when 'U' => return "procedure";
|
|
|
557 when 'u' => return "generic procedure";
|
|
|
558 when 'V' => return "function";
|
|
|
559 when 'v' => return "generic function";
|
|
|
560 when 'X' => return "exception";
|
|
|
561 when 'Y' => return "entry";
|
|
|
562
|
|
|
563 when '+' => return "private type";
|
|
|
564 when '*' => return "private variable";
|
|
|
565
|
|
|
566 -- The above should be the only possibilities, but for this kind
|
|
|
567 -- of informational output, we don't want to bomb if we find
|
|
|
568 -- something else, so just return three question marks when we
|
|
|
569 -- have an unknown Abbrev value
|
|
|
570
|
|
|
571 when others =>
|
|
|
572 if Is_Parameter (Decl) then
|
|
|
573 return "parameter";
|
|
|
574 else
|
|
|
575 return "??? (" & Get_Type (Decl) & ")";
|
|
|
576 end if;
|
|
|
577 end case;
|
|
|
578 end Get_Full_Type;
|
|
|
579
|
|
|
580 --------------------------
|
|
|
581 -- Skip_To_First_X_Line --
|
|
|
582 --------------------------
|
|
|
583
|
|
|
584 procedure Skip_To_First_X_Line
|
|
|
585 (File : in out ALI_File;
|
|
|
586 D_Lines : Boolean;
|
|
|
587 W_Lines : Boolean)
|
|
|
588 is
|
|
|
589 Ali : String_Access renames File.Buffer;
|
|
|
590 Token : Positive;
|
|
|
591 Ptr : Positive := Ali'First;
|
|
|
592 Num_Dependencies : Natural := 0;
|
|
|
593 File_Start : Positive;
|
|
|
594 File_End : Positive;
|
|
|
595 Gnatchop_Offset : Integer;
|
|
|
596 Gnatchop_Name : Positive;
|
|
|
597
|
|
|
598 File_Ref : File_Reference;
|
|
|
599 pragma Unreferenced (File_Ref);
|
|
|
600
|
|
|
601 begin
|
|
|
602 -- Read all the lines possibly processing with-clauses and dependency
|
|
|
603 -- information and exit on finding the first Xref line.
|
|
|
604 -- A fall-through of the loop means that there is no xref information
|
|
|
605 -- which is an error condition.
|
|
|
606
|
|
|
607 while Ali (Ptr) /= EOF loop
|
|
|
608 if D_Lines and then Ali (Ptr) = 'D' then
|
|
|
609
|
|
|
610 -- Found dependency information. Format looks like:
|
|
|
611 -- D src-nam time-stmp checksum [subunit-name] [line:file-name]
|
|
|
612
|
|
|
613 -- Skip the D and parse the filenam
|
|
|
614
|
|
|
615 Ptr := Ptr + 1;
|
|
|
616 Parse_Token (Ali, Ptr, Token);
|
|
|
617 File_Start := Token;
|
|
|
618 File_End := Ptr - 1;
|
|
|
619
|
|
|
620 Num_Dependencies := Num_Dependencies + 1;
|
|
|
621 Set_Last (File.Dep, Num_Dependencies);
|
|
|
622
|
|
|
623 Parse_Token (Ali, Ptr, Token); -- Skip time-stamp
|
|
|
624 Parse_Token (Ali, Ptr, Token); -- Skip checksum
|
|
|
625 Parse_Token (Ali, Ptr, Token); -- Read next entity on the line
|
|
|
626
|
|
|
627 if not (Ali (Token) in '0' .. '9') then
|
|
|
628 Parse_Token (Ali, Ptr, Token); -- Was a subunit name
|
|
|
629 end if;
|
|
|
630
|
|
|
631 -- Did we have a gnatchop-ed file with a pragma Source_Reference ?
|
|
|
632
|
|
|
633 Gnatchop_Offset := 0;
|
|
|
634
|
|
|
635 if Ali (Token) in '0' .. '9' then
|
|
|
636 Gnatchop_Name := Token;
|
|
|
637 while Ali (Gnatchop_Name) /= ':' loop
|
|
|
638 Gnatchop_Name := Gnatchop_Name + 1;
|
|
|
639 end loop;
|
|
|
640
|
|
|
641 Gnatchop_Offset :=
|
|
|
642 2 - Natural'Value (Ali (Token .. Gnatchop_Name - 1));
|
|
|
643 Token := Gnatchop_Name + 1;
|
|
|
644 end if;
|
|
|
645
|
|
|
646 declare
|
|
|
647 Table : Table_Type renames
|
|
|
648 File.Dep.Table (1 .. Last (File.Dep));
|
|
|
649 begin
|
|
|
650 Table (Num_Dependencies) := Add_To_Xref_File
|
|
|
651 (Ali (File_Start .. File_End),
|
|
|
652 Gnatchop_File => Ali (Token .. Ptr - 1),
|
|
|
653 Gnatchop_Offset => Gnatchop_Offset);
|
|
|
654 end;
|
|
|
655
|
|
|
656 elsif W_Lines and then Ali (Ptr) = 'W' then
|
|
|
657
|
|
|
658 -- Found with-clause information. Format looks like:
|
|
|
659 -- "W debug%s debug.adb debug.ali"
|
|
|
660
|
|
|
661 -- Skip the W and parse the .ali filename (3rd token)
|
|
|
662
|
|
|
663 Parse_Token (Ali, Ptr, Token);
|
|
|
664 Parse_Token (Ali, Ptr, Token);
|
|
|
665 Parse_Token (Ali, Ptr, Token);
|
|
|
666
|
|
|
667 File_Ref :=
|
|
|
668 Add_To_Xref_File (Ali (Token .. Ptr - 1), Visited => False);
|
|
|
669
|
|
|
670 elsif Ali (Ptr) = 'X' then
|
|
|
671
|
|
|
672 -- Found a cross-referencing line - stop processing
|
|
|
673
|
|
|
674 File.Current_Line := Ptr;
|
|
|
675 File.Xref_Line := Ptr;
|
|
|
676 return;
|
|
|
677 end if;
|
|
|
678
|
|
|
679 Parse_EOL (Ali, Ptr);
|
|
|
680 end loop;
|
|
|
681
|
|
|
682 raise No_Xref_Information;
|
|
|
683 end Skip_To_First_X_Line;
|
|
|
684
|
|
|
685 ----------
|
|
|
686 -- Open --
|
|
|
687 ----------
|
|
|
688
|
|
|
689 procedure Open
|
|
|
690 (Name : String;
|
|
|
691 File : out ALI_File;
|
|
|
692 Dependencies : Boolean := False)
|
|
|
693 is
|
|
|
694 Ali : String_Access renames File.Buffer;
|
|
|
695 pragma Warnings (Off, Ali);
|
|
|
696
|
|
|
697 begin
|
|
|
698 if File.Buffer /= null then
|
|
|
699 Free (File.Buffer);
|
|
|
700 end if;
|
|
|
701
|
|
|
702 Init (File.Dep);
|
|
|
703
|
|
|
704 begin
|
|
|
705 Read_File (Name, Ali);
|
|
|
706
|
|
|
707 exception
|
|
|
708 when Ada.Text_IO.Name_Error | Ada.Text_IO.End_Error =>
|
|
|
709 raise No_Xref_Information;
|
|
|
710 end;
|
|
|
711
|
|
|
712 Skip_To_First_X_Line (File, D_Lines => True, W_Lines => Dependencies);
|
|
|
713 end Open;
|
|
|
714
|
|
|
715 ---------------
|
|
|
716 -- Parse_EOL --
|
|
|
717 ---------------
|
|
|
718
|
|
|
719 procedure Parse_EOL
|
|
|
720 (Source : not null access String;
|
|
|
721 Ptr : in out Positive;
|
|
|
722 Skip_Continuation_Line : Boolean := False)
|
|
|
723 is
|
|
|
724 begin
|
|
|
725 loop
|
|
|
726 -- Skip to end of line
|
|
|
727
|
|
|
728 while Source (Ptr) /= ASCII.CR and then Source (Ptr) /= ASCII.LF
|
|
|
729 and then Source (Ptr) /= EOF
|
|
|
730 loop
|
|
|
731 Ptr := Ptr + 1;
|
|
|
732 end loop;
|
|
|
733
|
|
|
734 -- Skip CR or LF if not at end of file
|
|
|
735
|
|
|
736 if Source (Ptr) /= EOF then
|
|
|
737 Ptr := Ptr + 1;
|
|
|
738 end if;
|
|
|
739
|
|
|
740 -- Skip past CR/LF or LF/CR combination
|
|
|
741
|
|
|
742 if (Source (Ptr) = ASCII.CR or else Source (Ptr) = ASCII.LF)
|
|
|
743 and then Source (Ptr) /= Source (Ptr - 1)
|
|
|
744 then
|
|
|
745 Ptr := Ptr + 1;
|
|
|
746 end if;
|
|
|
747
|
|
|
748 exit when not Skip_Continuation_Line or else Source (Ptr) /= '.';
|
|
|
749 end loop;
|
|
|
750 end Parse_EOL;
|
|
|
751
|
|
|
752 ---------------------------
|
|
|
753 -- Parse_Identifier_Info --
|
|
|
754 ---------------------------
|
|
|
755
|
|
|
756 procedure Parse_Identifier_Info
|
|
|
757 (Pattern : Search_Pattern;
|
|
|
758 File : in out ALI_File;
|
|
|
759 Local_Symbols : Boolean;
|
|
|
760 Der_Info : Boolean := False;
|
|
|
761 Type_Tree : Boolean := False;
|
|
|
762 Wide_Search : Boolean := True;
|
|
|
763 Labels_As_Ref : Boolean := True)
|
|
|
764 is
|
|
|
765 Ptr : Positive renames File.Current_Line;
|
|
|
766 Ali : String_Access renames File.Buffer;
|
|
|
767
|
|
|
768 E_Line : Natural; -- Line number of current entity
|
|
|
769 E_Col : Natural; -- Column number of current entity
|
|
|
770 E_Type : Character; -- Type of current entity
|
|
|
771 E_Name : Positive; -- Pointer to begin of entity name
|
|
|
772 E_Global : Boolean; -- True iff entity is global
|
|
|
773
|
|
|
774 R_Line : Natural; -- Line number of current reference
|
|
|
775 R_Col : Natural; -- Column number of current reference
|
|
|
776 R_Type : Character; -- Type of current reference
|
|
|
777
|
|
|
778 Decl_Ref : Declaration_Reference;
|
|
|
779 File_Ref : File_Reference := Current_Xref_File (File);
|
|
|
780
|
|
|
781 function Get_Symbol_Name (Eun, Line, Col : Natural) return String;
|
|
|
782 -- Returns the symbol name for the entity defined at the specified
|
|
|
783 -- line and column in the dependent unit number Eun. For this we need
|
|
|
784 -- to parse the ali file again because the parent entity is not in
|
|
|
785 -- the declaration table if it did not match the search pattern.
|
|
|
786
|
|
|
787 procedure Skip_To_Matching_Closing_Bracket;
|
|
|
788 -- When Ptr points to an opening square bracket, moves it to the
|
|
|
789 -- character following the matching closing bracket
|
|
|
790
|
|
|
791 ---------------------
|
|
|
792 -- Get_Symbol_Name --
|
|
|
793 ---------------------
|
|
|
794
|
|
|
795 function Get_Symbol_Name (Eun, Line, Col : Natural) return String is
|
|
|
796 Ptr : Positive := 1;
|
|
|
797 E_Eun : Positive; -- Unit number of current entity
|
|
|
798 E_Line : Natural; -- Line number of current entity
|
|
|
799 E_Col : Natural; -- Column number of current entity
|
|
|
800 E_Name : Positive; -- Pointer to begin of entity name
|
|
|
801
|
|
|
802 begin
|
|
|
803 -- Look for the X lines corresponding to unit Eun
|
|
|
804
|
|
|
805 loop
|
|
|
806 if Ali (Ptr) = 'X' then
|
|
|
807 Ptr := Ptr + 1;
|
|
|
808 Parse_Number (Ali, Ptr, E_Eun);
|
|
|
809 exit when E_Eun = Eun;
|
|
|
810 end if;
|
|
|
811
|
|
|
812 Parse_EOL (Ali, Ptr, Skip_Continuation_Line => True);
|
|
|
813 end loop;
|
|
|
814
|
|
|
815 -- Here we are in the right Ali section, we now look for the entity
|
|
|
816 -- declared at position (Line, Col).
|
|
|
817
|
|
|
818 loop
|
|
|
819 Parse_Number (Ali, Ptr, E_Line);
|
|
|
820 exit when Ali (Ptr) = EOF;
|
|
|
821 Ptr := Ptr + 1;
|
|
|
822 Parse_Number (Ali, Ptr, E_Col);
|
|
|
823 exit when Ali (Ptr) = EOF;
|
|
|
824 Ptr := Ptr + 1;
|
|
|
825
|
|
|
826 if Line = E_Line and then Col = E_Col then
|
|
|
827 Parse_Token (Ali, Ptr, E_Name);
|
|
|
828 return Ali (E_Name .. Ptr - 1);
|
|
|
829 end if;
|
|
|
830
|
|
|
831 Parse_EOL (Ali, Ptr, Skip_Continuation_Line => True);
|
|
|
832 exit when Ali (Ptr) = EOF;
|
|
|
833 end loop;
|
|
|
834
|
|
|
835 -- We were not able to find the symbol, this should not happen but
|
|
|
836 -- since we don't want to stop here we return a string of three
|
|
|
837 -- question marks as the symbol name.
|
|
|
838
|
|
|
839 return "???";
|
|
|
840 end Get_Symbol_Name;
|
|
|
841
|
|
|
842 --------------------------------------
|
|
|
843 -- Skip_To_Matching_Closing_Bracket --
|
|
|
844 --------------------------------------
|
|
|
845
|
|
|
846 procedure Skip_To_Matching_Closing_Bracket is
|
|
|
847 Num_Brackets : Natural;
|
|
|
848
|
|
|
849 begin
|
|
|
850 Num_Brackets := 1;
|
|
|
851 while Num_Brackets /= 0 loop
|
|
|
852 Ptr := Ptr + 1;
|
|
|
853 if Ali (Ptr) = '[' then
|
|
|
854 Num_Brackets := Num_Brackets + 1;
|
|
|
855 elsif Ali (Ptr) = ']' then
|
|
|
856 Num_Brackets := Num_Brackets - 1;
|
|
|
857 end if;
|
|
|
858 end loop;
|
|
|
859
|
|
|
860 Ptr := Ptr + 1;
|
|
|
861 end Skip_To_Matching_Closing_Bracket;
|
|
|
862
|
|
|
863 Table : Table_Type renames File.Dep.Table (1 .. Last (File.Dep));
|
|
|
864
|
|
|
865 -- Start of processing for Parse_Identifier_Info
|
|
|
866
|
|
|
867 begin
|
|
|
868 -- The identifier info looks like:
|
|
|
869 -- "38U9*Debug 12|36r6 36r19"
|
|
|
870
|
|
|
871 -- Extract the line, column and entity name information
|
|
|
872
|
|
|
873 Parse_Number (Ali, Ptr, E_Line);
|
|
|
874
|
|
|
875 if Ali (Ptr) > ' ' then
|
|
|
876 E_Type := Ali (Ptr);
|
|
|
877 Ptr := Ptr + 1;
|
|
|
878 end if;
|
|
|
879
|
|
|
880 -- Ignore some of the entities (labels,...)
|
|
|
881
|
|
|
882 case E_Type is
|
|
|
883 when 'l' | 'L' | 'q' =>
|
|
|
884 Parse_EOL (Ali, Ptr, Skip_Continuation_Line => True);
|
|
|
885 return;
|
|
|
886
|
|
|
887 when others =>
|
|
|
888 null;
|
|
|
889 end case;
|
|
|
890
|
|
|
891 Parse_Number (Ali, Ptr, E_Col);
|
|
|
892
|
|
|
893 E_Global := False;
|
|
|
894 if Ali (Ptr) >= ' ' then
|
|
|
895 E_Global := (Ali (Ptr) = '*');
|
|
|
896 Ptr := Ptr + 1;
|
|
|
897 end if;
|
|
|
898
|
|
|
899 Parse_Token (Ali, Ptr, E_Name);
|
|
|
900
|
|
|
901 -- Exit if the symbol does not match or if we have a local symbol and we
|
|
|
902 -- do not want it or if the file is unknown.
|
|
|
903
|
|
|
904 if File.X_File = Empty_File then
|
|
|
905 return;
|
|
|
906 end if;
|
|
|
907
|
|
|
908 if (not Local_Symbols and not E_Global)
|
|
|
909 or else (Pattern.Initialized
|
|
|
910 and then not Match (Ali (E_Name .. Ptr - 1), Pattern.Entity))
|
|
|
911 or else (E_Name >= Ptr)
|
|
|
912 then
|
|
|
913 Decl_Ref := Add_Declaration
|
|
|
914 (File.X_File, Ali (E_Name .. Ptr - 1), E_Line, E_Col, E_Type,
|
|
|
915 Remove_Only => True);
|
|
|
916 Parse_EOL (Ali, Ptr, Skip_Continuation_Line => True);
|
|
|
917 return;
|
|
|
918 end if;
|
|
|
919
|
|
|
920 -- Insert the declaration in the table
|
|
|
921
|
|
|
922 Decl_Ref := Add_Declaration
|
|
|
923 (File.X_File, Ali (E_Name .. Ptr - 1), E_Line, E_Col, E_Type);
|
|
|
924
|
|
|
925 if Ali (Ptr) = '[' then
|
|
|
926 Skip_To_Matching_Closing_Bracket;
|
|
|
927 end if;
|
|
|
928
|
|
|
929 -- Skip any renaming indication
|
|
|
930
|
|
|
931 if Ali (Ptr) = '=' then
|
|
|
932 declare
|
|
|
933 P_Line, P_Column : Natural;
|
|
|
934 pragma Warnings (Off, P_Line);
|
|
|
935 pragma Warnings (Off, P_Column);
|
|
|
936 begin
|
|
|
937 Ptr := Ptr + 1;
|
|
|
938 Parse_Number (Ali, Ptr, P_Line);
|
|
|
939 Ptr := Ptr + 1;
|
|
|
940 Parse_Number (Ali, Ptr, P_Column);
|
|
|
941 end;
|
|
|
942 end if;
|
|
|
943
|
|
|
944 while Ptr <= Ali'Last
|
|
|
945 and then (Ali (Ptr) = '<'
|
|
|
946 or else Ali (Ptr) = '('
|
|
|
947 or else Ali (Ptr) = '{')
|
|
|
948 loop
|
|
|
949 -- Here we have a type derivation information. The format is
|
|
|
950 -- <3|12I45> which means that the current entity is derived from the
|
|
|
951 -- type defined in unit number 3, line 12 column 45. The pipe and
|
|
|
952 -- unit number is optional. It is specified only if the parent type
|
|
|
953 -- is not defined in the current unit.
|
|
|
954
|
|
|
955 -- We also have the format for generic instantiations, as in
|
|
|
956 -- 7a5*Uid(3|5I8[4|2]) 2|4r74
|
|
|
957
|
|
|
958 -- We could also have something like
|
|
|
959 -- 16I9*I<integer>
|
|
|
960 -- that indicates that I derives from the predefined type integer.
|
|
|
961
|
|
|
962 Ptr := Ptr + 1;
|
|
|
963
|
|
|
964 if Ali (Ptr) in '0' .. '9' then
|
|
|
965 Parse_Derived_Info : declare
|
|
|
966 P_Line : Natural; -- parent entity line
|
|
|
967 P_Column : Natural; -- parent entity column
|
|
|
968 P_Eun : Positive; -- parent entity file number
|
|
|
969
|
|
|
970 begin
|
|
|
971 Parse_Number (Ali, Ptr, P_Line);
|
|
|
972
|
|
|
973 -- If we have a pipe then the first number was the unit number
|
|
|
974
|
|
|
975 if Ali (Ptr) = '|' then
|
|
|
976 P_Eun := P_Line;
|
|
|
977 Ptr := Ptr + 1;
|
|
|
978
|
|
|
979 -- Now we have the line number
|
|
|
980
|
|
|
981 Parse_Number (Ali, Ptr, P_Line);
|
|
|
982
|
|
|
983 else
|
|
|
984 -- We don't have a unit number specified, so we set P_Eun to
|
|
|
985 -- the current unit.
|
|
|
986
|
|
|
987 for K in Table'Range loop
|
|
|
988 P_Eun := K;
|
|
|
989 exit when Table (K) = File_Ref;
|
|
|
990 end loop;
|
|
|
991 end if;
|
|
|
992
|
|
|
993 -- Then parse the type and column number
|
|
|
994
|
|
|
995 Ptr := Ptr + 1;
|
|
|
996 Parse_Number (Ali, Ptr, P_Column);
|
|
|
997
|
|
|
998 -- Skip the information for generics instantiations
|
|
|
999
|
|
|
1000 if Ali (Ptr) = '[' then
|
|
|
1001 Skip_To_Matching_Closing_Bracket;
|
|
|
1002 end if;
|
|
|
1003
|
|
|
1004 -- Skip '>', or ')' or '>'
|
|
|
1005
|
|
|
1006 Ptr := Ptr + 1;
|
|
|
1007
|
|
|
1008 -- The derived info is needed only is the derived info mode is
|
|
|
1009 -- on or if we want to output the type hierarchy
|
|
|
1010
|
|
|
1011 if Der_Info or else Type_Tree then
|
|
|
1012 declare
|
|
|
1013 Symbol : constant String :=
|
|
|
1014 Get_Symbol_Name (P_Eun, P_Line, P_Column);
|
|
|
1015 begin
|
|
|
1016 if Symbol /= "???" then
|
|
|
1017 Add_Parent
|
|
|
1018 (Decl_Ref,
|
|
|
1019 Symbol,
|
|
|
1020 P_Line,
|
|
|
1021 P_Column,
|
|
|
1022 Table (P_Eun));
|
|
|
1023 end if;
|
|
|
1024 end;
|
|
|
1025 end if;
|
|
|
1026
|
|
|
1027 if Type_Tree
|
|
|
1028 and then (Pattern.File_Ref = Empty_File
|
|
|
1029 or else
|
|
|
1030 Pattern.File_Ref = Current_Xref_File (File))
|
|
|
1031 then
|
|
|
1032 Search_Parent_Tree : declare
|
|
|
1033 Pattern : Search_Pattern; -- Parent type pattern
|
|
|
1034 File_Pos_Backup : Positive;
|
|
|
1035
|
|
|
1036 begin
|
|
|
1037 Add_Entity
|
|
|
1038 (Pattern,
|
|
|
1039 Get_Symbol_Name (P_Eun, P_Line, P_Column)
|
|
|
1040 & ':' & Get_Gnatchop_File (Table (P_Eun))
|
|
|
1041 & ':' & Get_Line (Get_Parent (Decl_Ref))
|
|
|
1042 & ':' & Get_Column (Get_Parent (Decl_Ref)),
|
|
|
1043 False);
|
|
|
1044
|
|
|
1045 -- No default match is needed to look for the parent type
|
|
|
1046 -- since we are using the fully qualified symbol name:
|
|
|
1047 -- symbol:file:line:column
|
|
|
1048
|
|
|
1049 Set_Default_Match (False);
|
|
|
1050
|
|
|
1051 -- The parent hierarchy is defined in the same unit as
|
|
|
1052 -- the derived type. So we want to revisit the unit.
|
|
|
1053
|
|
|
1054 File_Pos_Backup := File.Current_Line;
|
|
|
1055
|
|
|
1056 Skip_To_First_X_Line
|
|
|
1057 (File, D_Lines => False, W_Lines => False);
|
|
|
1058
|
|
|
1059 while File.Buffer (File.Current_Line) /= EOF loop
|
|
|
1060 Parse_X_Filename (File);
|
|
|
1061 Parse_Identifier_Info
|
|
|
1062 (Pattern => Pattern,
|
|
|
1063 File => File,
|
|
|
1064 Local_Symbols => False,
|
|
|
1065 Der_Info => Der_Info,
|
|
|
1066 Type_Tree => True,
|
|
|
1067 Wide_Search => False,
|
|
|
1068 Labels_As_Ref => Labels_As_Ref);
|
|
|
1069 end loop;
|
|
|
1070
|
|
|
1071 File.Current_Line := File_Pos_Backup;
|
|
|
1072 end Search_Parent_Tree;
|
|
|
1073 end if;
|
|
|
1074 end Parse_Derived_Info;
|
|
|
1075
|
|
|
1076 else
|
|
|
1077 while Ali (Ptr) /= '>'
|
|
|
1078 and then Ali (Ptr) /= ')'
|
|
|
1079 and then Ali (Ptr) /= '}'
|
|
|
1080 loop
|
|
|
1081 Ptr := Ptr + 1;
|
|
|
1082 end loop;
|
|
|
1083 Ptr := Ptr + 1;
|
|
|
1084 end if;
|
|
|
1085 end loop;
|
|
|
1086
|
|
|
1087 -- To find the body, we will have to parse the file too
|
|
|
1088
|
|
|
1089 if Wide_Search then
|
|
|
1090 declare
|
|
|
1091 File_Name : constant String := Get_Gnatchop_File (File.X_File);
|
|
|
1092 Ignored : File_Reference;
|
|
|
1093 begin
|
|
|
1094 Ignored := Add_To_Xref_File (ALI_File_Name (File_Name), False);
|
|
|
1095 end;
|
|
|
1096 end if;
|
|
|
1097
|
|
|
1098 -- Parse references to this entity.
|
|
|
1099 -- Ptr points to next reference with leading blanks
|
|
|
1100
|
|
|
1101 loop
|
|
|
1102 -- Process references on current line
|
|
|
1103
|
|
|
1104 while Ali (Ptr) = ' ' or else Ali (Ptr) = ASCII.HT loop
|
|
|
1105
|
|
|
1106 -- For every reference read the line, type and column,
|
|
|
1107 -- optionally preceded by a file number and a pipe symbol.
|
|
|
1108
|
|
|
1109 Parse_Number (Ali, Ptr, R_Line);
|
|
|
1110
|
|
|
1111 if Ali (Ptr) = Pipe then
|
|
|
1112 Ptr := Ptr + 1;
|
|
|
1113 File_Ref := File_Name (File, R_Line);
|
|
|
1114
|
|
|
1115 Parse_Number (Ali, Ptr, R_Line);
|
|
|
1116 end if;
|
|
|
1117
|
|
|
1118 if Ali (Ptr) > ' ' then
|
|
|
1119 R_Type := Ali (Ptr);
|
|
|
1120 Ptr := Ptr + 1;
|
|
|
1121 end if;
|
|
|
1122
|
|
|
1123 -- Imported entities may have an indication specifying information
|
|
|
1124 -- about the corresponding external name:
|
|
|
1125 -- 5U14*Foo2 5>20 6b<c,myfoo2>22 # Imported entity
|
|
|
1126 -- 5U14*Foo2 5>20 6i<c,myfoo2>22 # Exported entity
|
|
|
1127
|
|
|
1128 if (R_Type = 'b' or else R_Type = 'i')
|
|
|
1129 and then Ali (Ptr) = '<'
|
|
|
1130 then
|
|
|
1131 while Ptr <= Ali'Last
|
|
|
1132 and then Ali (Ptr) /= '>'
|
|
|
1133 loop
|
|
|
1134 Ptr := Ptr + 1;
|
|
|
1135 end loop;
|
|
|
1136 Ptr := Ptr + 1;
|
|
|
1137 end if;
|
|
|
1138
|
|
|
1139 Parse_Number (Ali, Ptr, R_Col);
|
|
|
1140
|
|
|
1141 -- Insert the reference or body in the table
|
|
|
1142
|
|
|
1143 Add_Reference
|
|
|
1144 (Decl_Ref, File_Ref, R_Line, R_Col, R_Type, Labels_As_Ref);
|
|
|
1145
|
|
|
1146 -- Skip generic information, if any
|
|
|
1147
|
|
|
1148 if Ali (Ptr) = '[' then
|
|
|
1149 declare
|
|
|
1150 Num_Nested : Integer := 1;
|
|
|
1151
|
|
|
1152 begin
|
|
|
1153 Ptr := Ptr + 1;
|
|
|
1154 while Num_Nested /= 0 loop
|
|
|
1155 if Ali (Ptr) = ']' then
|
|
|
1156 Num_Nested := Num_Nested - 1;
|
|
|
1157 elsif Ali (Ptr) = '[' then
|
|
|
1158 Num_Nested := Num_Nested + 1;
|
|
|
1159 end if;
|
|
|
1160
|
|
|
1161 Ptr := Ptr + 1;
|
|
|
1162 end loop;
|
|
|
1163 end;
|
|
|
1164 end if;
|
|
|
1165
|
|
|
1166 end loop;
|
|
|
1167
|
|
|
1168 Parse_EOL (Ali, Ptr);
|
|
|
1169
|
|
|
1170 -- Loop until new line is no continuation line
|
|
|
1171
|
|
|
1172 exit when Ali (Ptr) /= '.';
|
|
|
1173 Ptr := Ptr + 1;
|
|
|
1174 end loop;
|
|
|
1175 end Parse_Identifier_Info;
|
|
|
1176
|
|
|
1177 ------------------
|
|
|
1178 -- Parse_Number --
|
|
|
1179 ------------------
|
|
|
1180
|
|
|
1181 procedure Parse_Number
|
|
|
1182 (Source : not null access String;
|
|
|
1183 Ptr : in out Positive;
|
|
|
1184 Number : out Natural)
|
|
|
1185 is
|
|
|
1186 begin
|
|
|
1187 -- Skip separators
|
|
|
1188
|
|
|
1189 while Source (Ptr) = ' ' or else Source (Ptr) = ASCII.HT loop
|
|
|
1190 Ptr := Ptr + 1;
|
|
|
1191 end loop;
|
|
|
1192
|
|
|
1193 Number := 0;
|
|
|
1194 while Source (Ptr) in '0' .. '9' loop
|
|
|
1195 Number :=
|
|
|
1196 10 * Number + (Character'Pos (Source (Ptr)) - Character'Pos ('0'));
|
|
|
1197 Ptr := Ptr + 1;
|
|
|
1198 end loop;
|
|
|
1199 end Parse_Number;
|
|
|
1200
|
|
|
1201 -----------------
|
|
|
1202 -- Parse_Token --
|
|
|
1203 -----------------
|
|
|
1204
|
|
|
1205 procedure Parse_Token
|
|
|
1206 (Source : not null access String;
|
|
|
1207 Ptr : in out Positive;
|
|
|
1208 Token_Ptr : out Positive)
|
|
|
1209 is
|
|
|
1210 In_Quotes : Character := ASCII.NUL;
|
|
|
1211
|
|
|
1212 begin
|
|
|
1213 -- Skip separators
|
|
|
1214
|
|
|
1215 while Source (Ptr) = ' ' or else Source (Ptr) = ASCII.HT loop
|
|
|
1216 Ptr := Ptr + 1;
|
|
|
1217 end loop;
|
|
|
1218
|
|
|
1219 Token_Ptr := Ptr;
|
|
|
1220
|
|
|
1221 -- Find end-of-token
|
|
|
1222
|
|
|
1223 while (In_Quotes /= ASCII.NUL or else
|
|
|
1224 not (Source (Ptr) = ' '
|
|
|
1225 or else Source (Ptr) = ASCII.HT
|
|
|
1226 or else Source (Ptr) = '<'
|
|
|
1227 or else Source (Ptr) = '{'
|
|
|
1228 or else Source (Ptr) = '['
|
|
|
1229 or else Source (Ptr) = '='
|
|
|
1230 or else Source (Ptr) = '('))
|
|
|
1231 and then Source (Ptr) >= ' '
|
|
|
1232 loop
|
|
|
1233 -- Double-quotes are used for operators
|
|
|
1234 -- Simple-quotes are used for character constants, for instance when
|
|
|
1235 -- they are found in an enumeration type "type A is ('+', '-');"
|
|
|
1236
|
|
|
1237 case Source (Ptr) is
|
|
|
1238 when '"' | ''' =>
|
|
|
1239 if In_Quotes = Source (Ptr) then
|
|
|
1240 In_Quotes := ASCII.NUL;
|
|
|
1241 elsif In_Quotes = ASCII.NUL then
|
|
|
1242 In_Quotes := Source (Ptr);
|
|
|
1243 end if;
|
|
|
1244
|
|
|
1245 when others =>
|
|
|
1246 null;
|
|
|
1247 end case;
|
|
|
1248
|
|
|
1249 Ptr := Ptr + 1;
|
|
|
1250 end loop;
|
|
|
1251 end Parse_Token;
|
|
|
1252
|
|
|
1253 ----------------------
|
|
|
1254 -- Parse_X_Filename --
|
|
|
1255 ----------------------
|
|
|
1256
|
|
|
1257 procedure Parse_X_Filename (File : in out ALI_File) is
|
|
|
1258 Ali : String_Access renames File.Buffer;
|
|
|
1259 Ptr : Positive renames File.Current_Line;
|
|
|
1260 File_Nr : Natural;
|
|
|
1261
|
|
|
1262 Table : Table_Type renames File.Dep.Table (1 .. Last (File.Dep));
|
|
|
1263
|
|
|
1264 begin
|
|
|
1265 while Ali (Ptr) = 'X' loop
|
|
|
1266
|
|
|
1267 -- The current line is the start of a new Xref file section,
|
|
|
1268 -- whose format looks like:
|
|
|
1269
|
|
|
1270 -- " X 1 debug.ads"
|
|
|
1271
|
|
|
1272 -- Skip the X and read the file number for the new X_File
|
|
|
1273
|
|
|
1274 Ptr := Ptr + 1;
|
|
|
1275 Parse_Number (Ali, Ptr, File_Nr);
|
|
|
1276
|
|
|
1277 -- If the referenced file is unknown, we simply ignore it
|
|
|
1278
|
|
|
1279 if File_Nr in Table'Range then
|
|
|
1280 File.X_File := Table (File_Nr);
|
|
|
1281 else
|
|
|
1282 File.X_File := Empty_File;
|
|
|
1283 end if;
|
|
|
1284
|
|
|
1285 Parse_EOL (Ali, Ptr);
|
|
|
1286 end loop;
|
|
|
1287 end Parse_X_Filename;
|
|
|
1288
|
|
|
1289 --------------------
|
|
|
1290 -- Print_Gnatfind --
|
|
|
1291 --------------------
|
|
|
1292
|
|
|
1293 procedure Print_Gnatfind
|
|
|
1294 (References : Boolean;
|
|
|
1295 Full_Path_Name : Boolean)
|
|
|
1296 is
|
|
|
1297 Decls : constant Declaration_Array_Access := Get_Declarations;
|
|
|
1298 Decl : Declaration_Reference;
|
|
|
1299 Arr : Reference_Array_Access;
|
|
|
1300
|
|
|
1301 procedure Print_Ref
|
|
|
1302 (Ref : Reference;
|
|
|
1303 Msg : String := " ");
|
|
|
1304 -- Print a reference, according to the extended tag of the output
|
|
|
1305
|
|
|
1306 ---------------
|
|
|
1307 -- Print_Ref --
|
|
|
1308 ---------------
|
|
|
1309
|
|
|
1310 procedure Print_Ref
|
|
|
1311 (Ref : Reference;
|
|
|
1312 Msg : String := " ")
|
|
|
1313 is
|
|
|
1314 F : String_Access :=
|
|
|
1315 Osint.To_Host_File_Spec
|
|
|
1316 (Get_Gnatchop_File (Ref, Full_Path_Name));
|
|
|
1317
|
|
|
1318 Buffer : constant String :=
|
|
|
1319 F.all &
|
|
|
1320 ":" & Get_Line (Ref) &
|
|
|
1321 ":" & Get_Column (Ref) &
|
|
|
1322 ": ";
|
|
|
1323
|
|
|
1324 Num_Blanks : Integer := Longest_File_Name + 10 - Buffer'Length;
|
|
|
1325
|
|
|
1326 begin
|
|
|
1327 Free (F);
|
|
|
1328 Num_Blanks := Integer'Max (0, Num_Blanks);
|
|
|
1329 Write_Line
|
|
|
1330 (Buffer
|
|
|
1331 & String'(1 .. Num_Blanks => ' ')
|
|
|
1332 & Msg & " " & Get_Symbol (Decl));
|
|
|
1333
|
|
|
1334 if Get_Source_Line (Ref)'Length /= 0 then
|
|
|
1335 Write_Line (" " & Get_Source_Line (Ref));
|
|
|
1336 end if;
|
|
|
1337 end Print_Ref;
|
|
|
1338
|
|
|
1339 -- Start of processing for Print_Gnatfind
|
|
|
1340
|
|
|
1341 begin
|
|
|
1342 for D in Decls'Range loop
|
|
|
1343 Decl := Decls (D);
|
|
|
1344
|
|
|
1345 if Match (Decl) then
|
|
|
1346
|
|
|
1347 -- Output the declaration
|
|
|
1348
|
|
|
1349 declare
|
|
|
1350 Parent : constant Declaration_Reference := Get_Parent (Decl);
|
|
|
1351
|
|
|
1352 F : String_Access :=
|
|
|
1353 Osint.To_Host_File_Spec
|
|
|
1354 (Get_Gnatchop_File (Decl, Full_Path_Name));
|
|
|
1355
|
|
|
1356 Buffer : constant String :=
|
|
|
1357 F.all &
|
|
|
1358 ":" & Get_Line (Decl) &
|
|
|
1359 ":" & Get_Column (Decl) &
|
|
|
1360 ": ";
|
|
|
1361
|
|
|
1362 Num_Blanks : Integer := Longest_File_Name + 10 - Buffer'Length;
|
|
|
1363
|
|
|
1364 begin
|
|
|
1365 Free (F);
|
|
|
1366 Num_Blanks := Integer'Max (0, Num_Blanks);
|
|
|
1367 Write_Line
|
|
|
1368 (Buffer & String'(1 .. Num_Blanks => ' ')
|
|
|
1369 & "(spec) " & Get_Symbol (Decl));
|
|
|
1370
|
|
|
1371 if Parent /= Empty_Declaration then
|
|
|
1372 F := Osint.To_Host_File_Spec (Get_Gnatchop_File (Parent));
|
|
|
1373 Write_Line
|
|
|
1374 (Buffer & String'(1 .. Num_Blanks => ' ')
|
|
|
1375 & " derived from " & Get_Symbol (Parent)
|
|
|
1376 & " ("
|
|
|
1377 & F.all
|
|
|
1378 & ':' & Get_Line (Parent)
|
|
|
1379 & ':' & Get_Column (Parent) & ')');
|
|
|
1380 Free (F);
|
|
|
1381 end if;
|
|
|
1382 end;
|
|
|
1383
|
|
|
1384 if Get_Source_Line (Decl)'Length /= 0 then
|
|
|
1385 Write_Line (" " & Get_Source_Line (Decl));
|
|
|
1386 end if;
|
|
|
1387
|
|
|
1388 -- Output the body (sorted)
|
|
|
1389
|
|
|
1390 Arr := Get_References (Decl, Get_Bodies => True);
|
|
|
1391
|
|
|
1392 for R in Arr'Range loop
|
|
|
1393 Print_Ref (Arr (R), "(body)");
|
|
|
1394 end loop;
|
|
|
1395
|
|
|
1396 Free (Arr);
|
|
|
1397
|
|
|
1398 if References then
|
|
|
1399 Arr := Get_References
|
|
|
1400 (Decl, Get_Writes => True, Get_Reads => True);
|
|
|
1401
|
|
|
1402 for R in Arr'Range loop
|
|
|
1403 Print_Ref (Arr (R));
|
|
|
1404 end loop;
|
|
|
1405
|
|
|
1406 Free (Arr);
|
|
|
1407 end if;
|
|
|
1408 end if;
|
|
|
1409 end loop;
|
|
|
1410 end Print_Gnatfind;
|
|
|
1411
|
|
|
1412 ------------------
|
|
|
1413 -- Print_Unused --
|
|
|
1414 ------------------
|
|
|
1415
|
|
|
1416 procedure Print_Unused (Full_Path_Name : Boolean) is
|
|
|
1417 Decls : constant Declaration_Array_Access := Get_Declarations;
|
|
|
1418 Decl : Declaration_Reference;
|
|
|
1419 Arr : Reference_Array_Access;
|
|
|
1420 F : String_Access;
|
|
|
1421
|
|
|
1422 begin
|
|
|
1423 for D in Decls'Range loop
|
|
|
1424 Decl := Decls (D);
|
|
|
1425
|
|
|
1426 if References_Count
|
|
|
1427 (Decl, Get_Reads => True, Get_Writes => True) = 0
|
|
|
1428 then
|
|
|
1429 F := Osint.To_Host_File_Spec
|
|
|
1430 (Get_Gnatchop_File (Decl, Full_Path_Name));
|
|
|
1431 Write_Str (Get_Symbol (Decl)
|
|
|
1432 & " ("
|
|
|
1433 & Get_Full_Type (Decl)
|
|
|
1434 & ") "
|
|
|
1435 & F.all
|
|
|
1436 & ':'
|
|
|
1437 & Get_Line (Decl)
|
|
|
1438 & ':'
|
|
|
1439 & Get_Column (Decl));
|
|
|
1440 Free (F);
|
|
|
1441
|
|
|
1442 -- Print the body if any
|
|
|
1443
|
|
|
1444 Arr := Get_References (Decl, Get_Bodies => True);
|
|
|
1445
|
|
|
1446 for R in Arr'Range loop
|
|
|
1447 F := Osint.To_Host_File_Spec
|
|
|
1448 (Get_Gnatchop_File (Arr (R), Full_Path_Name));
|
|
|
1449 Write_Str (' '
|
|
|
1450 & F.all
|
|
|
1451 & ':' & Get_Line (Arr (R))
|
|
|
1452 & ':' & Get_Column (Arr (R)));
|
|
|
1453 Free (F);
|
|
|
1454 end loop;
|
|
|
1455
|
|
|
1456 Write_Eol;
|
|
|
1457 Free (Arr);
|
|
|
1458 end if;
|
|
|
1459 end loop;
|
|
|
1460 end Print_Unused;
|
|
|
1461
|
|
|
1462 --------------
|
|
|
1463 -- Print_Vi --
|
|
|
1464 --------------
|
|
|
1465
|
|
|
1466 procedure Print_Vi (Full_Path_Name : Boolean) is
|
|
|
1467 Tab : constant Character := ASCII.HT;
|
|
|
1468 Decls : constant Declaration_Array_Access :=
|
|
|
1469 Get_Declarations (Sorted => False);
|
|
|
1470 Decl : Declaration_Reference;
|
|
|
1471 Arr : Reference_Array_Access;
|
|
|
1472 F : String_Access;
|
|
|
1473
|
|
|
1474 begin
|
|
|
1475 for D in Decls'Range loop
|
|
|
1476 Decl := Decls (D);
|
|
|
1477
|
|
|
1478 F := Osint.To_Host_File_Spec (Get_File (Decl, Full_Path_Name));
|
|
|
1479 Write_Line (Get_Symbol (Decl) & Tab & F.all & Tab & Get_Line (Decl));
|
|
|
1480 Free (F);
|
|
|
1481
|
|
|
1482 -- Print the body if any
|
|
|
1483
|
|
|
1484 Arr := Get_References (Decl, Get_Bodies => True);
|
|
|
1485
|
|
|
1486 for R in Arr'Range loop
|
|
|
1487 F := Osint.To_Host_File_Spec (Get_File (Arr (R), Full_Path_Name));
|
|
|
1488 Write_Line
|
|
|
1489 (Get_Symbol (Decl) & Tab & F.all & Tab & Get_Line (Arr (R)));
|
|
|
1490 Free (F);
|
|
|
1491 end loop;
|
|
|
1492
|
|
|
1493 Free (Arr);
|
|
|
1494
|
|
|
1495 -- Print the modifications
|
|
|
1496
|
|
|
1497 Arr := Get_References (Decl, Get_Writes => True, Get_Reads => True);
|
|
|
1498
|
|
|
1499 for R in Arr'Range loop
|
|
|
1500 F := Osint.To_Host_File_Spec (Get_File (Arr (R), Full_Path_Name));
|
|
|
1501 Write_Line
|
|
|
1502 (Get_Symbol (Decl) & Tab & F.all & Tab & Get_Line (Arr (R)));
|
|
|
1503 Free (F);
|
|
|
1504 end loop;
|
|
|
1505
|
|
|
1506 Free (Arr);
|
|
|
1507 end loop;
|
|
|
1508 end Print_Vi;
|
|
|
1509
|
|
|
1510 ----------------
|
|
|
1511 -- Print_Xref --
|
|
|
1512 ----------------
|
|
|
1513
|
|
|
1514 procedure Print_Xref (Full_Path_Name : Boolean) is
|
|
|
1515 Decls : constant Declaration_Array_Access := Get_Declarations;
|
|
|
1516 Decl : Declaration_Reference;
|
|
|
1517
|
|
|
1518 Margin : constant := 10;
|
|
|
1519 -- Column where file names start
|
|
|
1520
|
|
|
1521 procedure New_Line80;
|
|
|
1522 -- Go to start of new line
|
|
|
1523
|
|
|
1524 procedure Print80 (S : String);
|
|
|
1525 -- Print the text, respecting the 80 columns rule
|
|
|
1526
|
|
|
1527 procedure Print_Ref (Line, Column : String);
|
|
|
1528 -- The beginning of the output is aligned on a column multiple of 9
|
|
|
1529
|
|
|
1530 procedure Print_List
|
|
|
1531 (Decl : Declaration_Reference;
|
|
|
1532 Msg : String;
|
|
|
1533 Get_Reads : Boolean := False;
|
|
|
1534 Get_Writes : Boolean := False;
|
|
|
1535 Get_Bodies : Boolean := False);
|
|
|
1536 -- Print a list of references. If the list is not empty, Msg will
|
|
|
1537 -- be printed prior to the list.
|
|
|
1538
|
|
|
1539 ----------------
|
|
|
1540 -- New_Line80 --
|
|
|
1541 ----------------
|
|
|
1542
|
|
|
1543 procedure New_Line80 is
|
|
|
1544 begin
|
|
|
1545 Write_Eol;
|
|
|
1546 Write_Str (String'(1 .. Margin - 1 => ' '));
|
|
|
1547 end New_Line80;
|
|
|
1548
|
|
|
1549 -------------
|
|
|
1550 -- Print80 --
|
|
|
1551 -------------
|
|
|
1552
|
|
|
1553 procedure Print80 (S : String) is
|
|
|
1554 Align : Natural := Margin - (Integer (Column) mod Margin);
|
|
|
1555
|
|
|
1556 begin
|
|
|
1557 if Align = Margin then
|
|
|
1558 Align := 0;
|
|
|
1559 end if;
|
|
|
1560
|
|
|
1561 Write_Str (String'(1 .. Align => ' ') & S);
|
|
|
1562 end Print80;
|
|
|
1563
|
|
|
1564 ---------------
|
|
|
1565 -- Print_Ref --
|
|
|
1566 ---------------
|
|
|
1567
|
|
|
1568 procedure Print_Ref (Line, Column : String) is
|
|
|
1569 Line_Align : constant Integer := 4 - Line'Length;
|
|
|
1570
|
|
|
1571 S : constant String := String'(1 .. Line_Align => ' ')
|
|
|
1572 & Line & ':' & Column;
|
|
|
1573
|
|
|
1574 Align : Natural := Margin - (Integer (Output.Column) mod Margin);
|
|
|
1575
|
|
|
1576 begin
|
|
|
1577 if Align = Margin then
|
|
|
1578 Align := 0;
|
|
|
1579 end if;
|
|
|
1580
|
|
|
1581 if Integer (Output.Column) + Align + S'Length > 79 then
|
|
|
1582 New_Line80;
|
|
|
1583 Align := 0;
|
|
|
1584 end if;
|
|
|
1585
|
|
|
1586 Write_Str (String'(1 .. Align => ' ') & S);
|
|
|
1587 end Print_Ref;
|
|
|
1588
|
|
|
1589 ----------------
|
|
|
1590 -- Print_List --
|
|
|
1591 ----------------
|
|
|
1592
|
|
|
1593 procedure Print_List
|
|
|
1594 (Decl : Declaration_Reference;
|
|
|
1595 Msg : String;
|
|
|
1596 Get_Reads : Boolean := False;
|
|
|
1597 Get_Writes : Boolean := False;
|
|
|
1598 Get_Bodies : Boolean := False)
|
|
|
1599 is
|
|
|
1600 Arr : Reference_Array_Access :=
|
|
|
1601 Get_References
|
|
|
1602 (Decl,
|
|
|
1603 Get_Writes => Get_Writes,
|
|
|
1604 Get_Reads => Get_Reads,
|
|
|
1605 Get_Bodies => Get_Bodies);
|
|
|
1606 File : File_Reference := Empty_File;
|
|
|
1607 F : String_Access;
|
|
|
1608
|
|
|
1609 begin
|
|
|
1610 if Arr'Length /= 0 then
|
|
|
1611 Write_Eol;
|
|
|
1612 Write_Str (Msg);
|
|
|
1613 end if;
|
|
|
1614
|
|
|
1615 for R in Arr'Range loop
|
|
|
1616 if Get_File_Ref (Arr (R)) /= File then
|
|
|
1617 if File /= Empty_File then
|
|
|
1618 New_Line80;
|
|
|
1619 end if;
|
|
|
1620
|
|
|
1621 File := Get_File_Ref (Arr (R));
|
|
|
1622 F := Osint.To_Host_File_Spec
|
|
|
1623 (Get_Gnatchop_File (Arr (R), Full_Path_Name));
|
|
|
1624
|
|
|
1625 if F = null then
|
|
|
1626 Write_Str ("<unknown> ");
|
|
|
1627 else
|
|
|
1628 Write_Str (F.all & ' ');
|
|
|
1629 Free (F);
|
|
|
1630 end if;
|
|
|
1631 end if;
|
|
|
1632
|
|
|
1633 Print_Ref (Get_Line (Arr (R)), Get_Column (Arr (R)));
|
|
|
1634 end loop;
|
|
|
1635
|
|
|
1636 Free (Arr);
|
|
|
1637 end Print_List;
|
|
|
1638
|
|
|
1639 F : String_Access;
|
|
|
1640
|
|
|
1641 -- Start of processing for Print_Xref
|
|
|
1642
|
|
|
1643 begin
|
|
|
1644 for D in Decls'Range loop
|
|
|
1645 Decl := Decls (D);
|
|
|
1646
|
|
|
1647 Write_Str (Get_Symbol (Decl));
|
|
|
1648
|
|
|
1649 -- Put the declaration type in column Type_Position, but if the
|
|
|
1650 -- declaration name is too long, put at least one space between its
|
|
|
1651 -- name and its type.
|
|
|
1652
|
|
|
1653 while Column < Type_Position - 1 loop
|
|
|
1654 Write_Char (' ');
|
|
|
1655 end loop;
|
|
|
1656
|
|
|
1657 Write_Char (' ');
|
|
|
1658
|
|
|
1659 Write_Line (Get_Full_Type (Decl));
|
|
|
1660
|
|
|
1661 Write_Parent_Info : declare
|
|
|
1662 Parent : constant Declaration_Reference := Get_Parent (Decl);
|
|
|
1663
|
|
|
1664 begin
|
|
|
1665 if Parent /= Empty_Declaration then
|
|
|
1666 Write_Str (" Ptype: ");
|
|
|
1667 F := Osint.To_Host_File_Spec (Get_Gnatchop_File (Parent));
|
|
|
1668 Print80 (F.all);
|
|
|
1669 Free (F);
|
|
|
1670 Print_Ref (Get_Line (Parent), Get_Column (Parent));
|
|
|
1671 Print80 (" " & Get_Symbol (Parent));
|
|
|
1672 Write_Eol;
|
|
|
1673 end if;
|
|
|
1674 end Write_Parent_Info;
|
|
|
1675
|
|
|
1676 Write_Str (" Decl: ");
|
|
|
1677 F := Osint.To_Host_File_Spec
|
|
|
1678 (Get_Gnatchop_File (Decl, Full_Path_Name));
|
|
|
1679
|
|
|
1680 if F = null then
|
|
|
1681 Print80 ("<unknown> ");
|
|
|
1682 else
|
|
|
1683 Print80 (F.all & ' ');
|
|
|
1684 Free (F);
|
|
|
1685 end if;
|
|
|
1686
|
|
|
1687 Print_Ref (Get_Line (Decl), Get_Column (Decl));
|
|
|
1688
|
|
|
1689 Print_List
|
|
|
1690 (Decl, " Body: ", Get_Bodies => True);
|
|
|
1691 Print_List
|
|
|
1692 (Decl, " Modi: ", Get_Writes => True);
|
|
|
1693 Print_List
|
|
|
1694 (Decl, " Ref: ", Get_Reads => True);
|
|
|
1695 Write_Eol;
|
|
|
1696 end loop;
|
|
|
1697 end Print_Xref;
|
|
|
1698
|
|
|
1699 ------------
|
|
|
1700 -- Search --
|
|
|
1701 ------------
|
|
|
1702
|
|
|
1703 procedure Search
|
|
|
1704 (Pattern : Search_Pattern;
|
|
|
1705 Local_Symbols : Boolean;
|
|
|
1706 Wide_Search : Boolean;
|
|
|
1707 Read_Only : Boolean;
|
|
|
1708 Der_Info : Boolean;
|
|
|
1709 Type_Tree : Boolean)
|
|
|
1710 is
|
|
|
1711 type String_Access is access String;
|
|
|
1712 procedure Free is new Unchecked_Deallocation (String, String_Access);
|
|
|
1713
|
|
|
1714 ALIfile : ALI_File;
|
|
|
1715 File_Ref : File_Reference;
|
|
|
1716 Strip_Num : Natural := 0;
|
|
|
1717 Ali_Name : String_Access;
|
|
|
1718
|
|
|
1719 begin
|
|
|
1720 -- If we want all the .ali files, then find them
|
|
|
1721
|
|
|
1722 if Wide_Search then
|
|
|
1723 Find_ALI_Files;
|
|
|
1724 end if;
|
|
|
1725
|
|
|
1726 loop
|
|
|
1727 -- Get the next unread ali file
|
|
|
1728
|
|
|
1729 File_Ref := Next_Unvisited_File;
|
|
|
1730
|
|
|
1731 exit when File_Ref = Empty_File;
|
|
|
1732
|
|
|
1733 -- Find the ALI file to use. Most of the time, it will be the unit
|
|
|
1734 -- name, with a different extension. However, when dealing with
|
|
|
1735 -- separates the ALI file is in fact the parent's ALI file (and this
|
|
|
1736 -- is recursive, in case the parent itself is a separate).
|
|
|
1737
|
|
|
1738 Strip_Num := 0;
|
|
|
1739 loop
|
|
|
1740 Free (Ali_Name);
|
|
|
1741 Ali_Name := new String'
|
|
|
1742 (Get_File (File_Ref, With_Dir => True, Strip => Strip_Num));
|
|
|
1743
|
|
|
1744 -- Stripped too many things...
|
|
|
1745
|
|
|
1746 if Ali_Name.all = "" then
|
|
|
1747 if Get_Emit_Warning (File_Ref) then
|
|
|
1748 Set_Standard_Error;
|
|
|
1749 Write_Line
|
|
|
1750 ("warning : file " & Get_File (File_Ref, With_Dir => True)
|
|
|
1751 & " not found");
|
|
|
1752 Set_Standard_Output;
|
|
|
1753 end if;
|
|
|
1754 Free (Ali_Name);
|
|
|
1755 exit;
|
|
|
1756
|
|
|
1757 -- If not found, try the parent's ALI file (this is needed for
|
|
|
1758 -- separate units and subprograms).
|
|
|
1759
|
|
|
1760 -- Reset the cached directory first, in case the separate's
|
|
|
1761 -- ALI file is not in the same directory.
|
|
|
1762
|
|
|
1763 elsif not File_Exists (Ali_Name.all) then
|
|
|
1764 Strip_Num := Strip_Num + 1;
|
|
|
1765 Reset_Directory (File_Ref);
|
|
|
1766
|
|
|
1767 -- Else we finally found it
|
|
|
1768
|
|
|
1769 else
|
|
|
1770 exit;
|
|
|
1771 end if;
|
|
|
1772 end loop;
|
|
|
1773
|
|
|
1774 -- If we had to get the parent's ALI, insert it in the list as usual.
|
|
|
1775 -- This is to avoid parsing it twice in case it has already been
|
|
|
1776 -- parsed.
|
|
|
1777
|
|
|
1778 if Ali_Name /= null and then Strip_Num /= 0 then
|
|
|
1779 File_Ref := Add_To_Xref_File
|
|
|
1780 (File_Name => Ali_Name.all,
|
|
|
1781 Visited => False);
|
|
|
1782
|
|
|
1783 -- Now that we have a file name, parse it to find any reference to
|
|
|
1784 -- the entity.
|
|
|
1785
|
|
|
1786 elsif Ali_Name /= null
|
|
|
1787 and then (Read_Only or else Is_Writable_File (Ali_Name.all))
|
|
|
1788 then
|
|
|
1789 begin
|
|
|
1790 Open (Ali_Name.all, ALIfile);
|
|
|
1791
|
|
|
1792 -- The cross-reference section in the ALI file may be followed
|
|
|
1793 -- by other sections, which can be identified by the starting
|
|
|
1794 -- character of every line, which should neither be 'X' nor a
|
|
|
1795 -- figure in '1' .. '9'.
|
|
|
1796
|
|
|
1797 -- The loop tests below also take into account the end-of-file
|
|
|
1798 -- possibility.
|
|
|
1799
|
|
|
1800 while ALIfile.Buffer (ALIfile.Current_Line) = 'X' loop
|
|
|
1801 Parse_X_Filename (ALIfile);
|
|
|
1802
|
|
|
1803 while ALIfile.Buffer (ALIfile.Current_Line) in '1' .. '9'
|
|
|
1804 loop
|
|
|
1805 Parse_Identifier_Info
|
|
|
1806 (Pattern, ALIfile, Local_Symbols, Der_Info, Type_Tree,
|
|
|
1807 Wide_Search, Labels_As_Ref => True);
|
|
|
1808 end loop;
|
|
|
1809 end loop;
|
|
|
1810
|
|
|
1811 exception
|
|
|
1812 when No_Xref_Information =>
|
|
|
1813 if Get_Emit_Warning (File_Ref) then
|
|
|
1814 Set_Standard_Error;
|
|
|
1815 Write_Line
|
|
|
1816 ("warning : No cross-referencing information in "
|
|
|
1817 & Ali_Name.all);
|
|
|
1818 Set_Standard_Output;
|
|
|
1819 end if;
|
|
|
1820 end;
|
|
|
1821 end if;
|
|
|
1822 end loop;
|
|
|
1823
|
|
|
1824 Free (Ali_Name);
|
|
|
1825 end Search;
|
|
|
1826
|
|
|
1827 -----------------
|
|
|
1828 -- Search_Xref --
|
|
|
1829 -----------------
|
|
|
1830
|
|
|
1831 procedure Search_Xref
|
|
|
1832 (Local_Symbols : Boolean;
|
|
|
1833 Read_Only : Boolean;
|
|
|
1834 Der_Info : Boolean)
|
|
|
1835 is
|
|
|
1836 ALIfile : ALI_File;
|
|
|
1837 File_Ref : File_Reference;
|
|
|
1838 Null_Pattern : Search_Pattern;
|
|
|
1839
|
|
|
1840 begin
|
|
|
1841 Null_Pattern.Initialized := False;
|
|
|
1842
|
|
|
1843 loop
|
|
|
1844 -- Find the next unvisited file
|
|
|
1845
|
|
|
1846 File_Ref := Next_Unvisited_File;
|
|
|
1847 exit when File_Ref = Empty_File;
|
|
|
1848
|
|
|
1849 -- Search the object directories for the .ali file
|
|
|
1850
|
|
|
1851 declare
|
|
|
1852 F : constant String := Get_File (File_Ref, With_Dir => True);
|
|
|
1853
|
|
|
1854 begin
|
|
|
1855 if Read_Only or else Is_Writable_File (F) then
|
|
|
1856 Open (F, ALIfile, True);
|
|
|
1857
|
|
|
1858 -- The cross-reference section in the ALI file may be followed
|
|
|
1859 -- by other sections, which can be identified by the starting
|
|
|
1860 -- character of every line, which should neither be 'X' nor a
|
|
|
1861 -- figure in '1' .. '9'.
|
|
|
1862
|
|
|
1863 -- The loop tests below also take into account the end-of-file
|
|
|
1864 -- possibility.
|
|
|
1865
|
|
|
1866 while ALIfile.Buffer (ALIfile.Current_Line) = 'X' loop
|
|
|
1867 Parse_X_Filename (ALIfile);
|
|
|
1868
|
|
|
1869 while ALIfile.Buffer (ALIfile.Current_Line) in '1' .. '9'
|
|
|
1870 loop
|
|
|
1871 Parse_Identifier_Info
|
|
|
1872 (Null_Pattern, ALIfile, Local_Symbols, Der_Info,
|
|
|
1873 Labels_As_Ref => False);
|
|
|
1874 end loop;
|
|
|
1875 end loop;
|
|
|
1876 end if;
|
|
|
1877
|
|
|
1878 exception
|
|
|
1879 when No_Xref_Information => null;
|
|
|
1880 end;
|
|
|
1881 end loop;
|
|
|
1882 end Search_Xref;
|
|
|
1883
|
|
|
1884 end Xref_Lib;
|
