Mercurial > hg > CbC > CbC_gcc

comparison gcc/ada/xref_lib.adb @ 111:04ced10e8804

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children 84e7813d76e9
comparison
equal deleted inserted replaced
68:561a7518be6b 111:04ced10e8804
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;