1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1998-2008, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 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. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 with Types; use Types;
30 with Ada.Unchecked_Conversion;
31 with Ada.Unchecked_Deallocation;
32 with Ada.Strings.Fixed;
35 with Ada.Characters.Handling; use Ada.Characters.Handling;
36 with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
38 with GNAT.OS_Lib; use GNAT.OS_Lib;
39 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
40 with GNAT.HTable; use GNAT.HTable;
41 with GNAT.Heap_Sort_G;
43 package body Xr_Tabls is
45 type HTable_Headers is range 1 .. 10000;
47 procedure Set_Next (E : File_Reference; Next : File_Reference);
48 function Next (E : File_Reference) return File_Reference;
49 function Get_Key (E : File_Reference) return Cst_String_Access;
50 function Hash (F : Cst_String_Access) return HTable_Headers;
51 function Equal (F1, F2 : Cst_String_Access) return Boolean;
52 -- The five subprograms above are used to instantiate the static
53 -- htable to store the files that should be processed.
55 package File_HTable is new GNAT.HTable.Static_HTable
56 (Header_Num => HTable_Headers,
57 Element => File_Record,
58 Elmt_Ptr => File_Reference,
62 Key => Cst_String_Access,
66 -- A hash table to store all the files referenced in the
67 -- application. The keys in this htable are the name of the files
68 -- themselves, therefore it is assumed that the source path
69 -- doesn't contain twice the same source or ALI file name
71 type Unvisited_Files_Record;
72 type Unvisited_Files_Access is access Unvisited_Files_Record;
73 type Unvisited_Files_Record is record
74 File : File_Reference;
75 Next : Unvisited_Files_Access;
77 -- A special list, in addition to File_HTable, that only stores
78 -- the files that haven't been visited so far. Note that the File
79 -- list points to some data in File_HTable, and thus should never be freed.
81 function Next (E : Declaration_Reference) return Declaration_Reference;
82 procedure Set_Next (E, Next : Declaration_Reference);
83 function Get_Key (E : Declaration_Reference) return Cst_String_Access;
84 -- The subprograms above are used to instantiate the static
85 -- htable to store the entities that have been found in the application
87 package Entities_HTable is new GNAT.HTable.Static_HTable
88 (Header_Num => HTable_Headers,
89 Element => Declaration_Record,
90 Elmt_Ptr => Declaration_Reference,
94 Key => Cst_String_Access,
98 -- A hash table to store all the entities defined in the
99 -- application. For each entity, we store a list of its reference
100 -- locations as well.
101 -- The keys in this htable should be created with Key_From_Ref,
102 -- and are the file, line and column of the declaration, which are
103 -- unique for every entity.
105 Entities_Count : Natural := 0;
106 -- Number of entities in Entities_HTable. This is used in the end
107 -- when sorting the table.
109 Longest_File_Name_In_Table : Natural := 0;
110 Unvisited_Files : Unvisited_Files_Access := null;
111 Directories : Project_File_Ptr;
112 Default_Match : Boolean := False;
113 -- The above need commenting ???
115 function Parse_Gnatls_Src return String;
116 -- Return the standard source directories (taking into account the
117 -- ADA_INCLUDE_PATH environment variable, if Osint.Add_Default_Search_Dirs
118 -- was called first).
120 function Parse_Gnatls_Obj return String;
121 -- Return the standard object directories (taking into account the
122 -- ADA_OBJECTS_PATH environment variable).
124 function Key_From_Ref
125 (File_Ref : File_Reference;
129 -- Return a key for the symbol declared at File_Ref, Line,
130 -- Column. This key should be used for lookup in Entity_HTable
132 function Is_Less_Than (Decl1, Decl2 : Declaration_Reference) return Boolean;
133 -- Compare two declarations (the comparison is case-insensitive)
135 function Is_Less_Than (Ref1, Ref2 : Reference) return Boolean;
136 -- Compare two references
138 procedure Store_References
139 (Decl : Declaration_Reference;
140 Get_Writes : Boolean := False;
141 Get_Reads : Boolean := False;
142 Get_Bodies : Boolean := False;
143 Get_Declaration : Boolean := False;
144 Arr : in out Reference_Array;
145 Index : in out Natural);
146 -- Store in Arr, starting at Index, all the references to Decl. The Get_*
147 -- parameters can be used to indicate which references should be stored.
148 -- Constraint_Error will be raised if Arr is not big enough.
150 procedure Sort (Arr : in out Reference_Array);
151 -- Sort an array of references (Arr'First must be 1)
157 procedure Set_Next (E : File_Reference; Next : File_Reference) is
163 (E : Declaration_Reference; Next : Declaration_Reference) is
172 function Get_Key (E : File_Reference) return Cst_String_Access is
177 function Get_Key (E : Declaration_Reference) return Cst_String_Access is
186 function Hash (F : Cst_String_Access) return HTable_Headers is
187 function H is new GNAT.HTable.Hash (HTable_Headers);
197 function Equal (F1, F2 : Cst_String_Access) return Boolean is
199 return F1.all = F2.all;
206 function Key_From_Ref
207 (File_Ref : File_Reference;
213 return File_Ref.File.all & Natural'Image (Line) & Natural'Image (Column);
216 ---------------------
217 -- Add_Declaration --
218 ---------------------
220 function Add_Declaration
221 (File_Ref : File_Reference;
225 Decl_Type : Character;
226 Remove_Only : Boolean := False;
227 Symbol_Match : Boolean := True)
228 return Declaration_Reference
230 procedure Unchecked_Free is new Ada.Unchecked_Deallocation
231 (Declaration_Record, Declaration_Reference);
233 Key : aliased constant String := Key_From_Ref (File_Ref, Line, Column);
235 New_Decl : Declaration_Reference :=
236 Entities_HTable.Get (Key'Unchecked_Access);
238 Is_Parameter : Boolean := False;
241 -- Insert the Declaration in the table. There might already be a
242 -- declaration in the table if the entity is a parameter, so we
243 -- need to check that first.
245 if New_Decl /= null and then New_Decl.Symbol_Length = 0 then
246 Is_Parameter := New_Decl.Is_Parameter;
247 Entities_HTable.Remove (Key'Unrestricted_Access);
248 Entities_Count := Entities_Count - 1;
250 Unchecked_Free (New_Decl);
254 -- The declaration might also already be there for parent types. In
255 -- this case, we should keep the entry, since some other entries are
259 and then not Remove_Only
262 new Declaration_Record'
263 (Symbol_Length => Symbol'Length,
265 Key => new String'(Key),
266 Decl => new Reference_Record'
272 Is_Parameter => Is_Parameter,
273 Decl_Type => Decl_Type,
277 Match => Symbol_Match
280 or else Match (File_Ref, Line, Column)),
284 Entities_HTable.Set (New_Decl);
285 Entities_Count := Entities_Count + 1;
287 if New_Decl.Match then
288 Longest_File_Name_In_Table :=
289 Natural'Max (File_Ref.File'Length, Longest_File_Name_In_Table);
292 elsif New_Decl /= null
293 and then not New_Decl.Match
295 New_Decl.Match := Default_Match
296 or else Match (File_Ref, Line, Column);
302 ----------------------
303 -- Add_To_Xref_File --
304 ----------------------
306 function Add_To_Xref_File
308 Visited : Boolean := True;
309 Emit_Warning : Boolean := False;
310 Gnatchop_File : String := "";
311 Gnatchop_Offset : Integer := 0) return File_Reference
313 Base : aliased constant String := Base_Name (File_Name);
314 Dir : constant String := Dir_Name (File_Name);
315 Dir_Acc : GNAT.OS_Lib.String_Access := null;
316 Ref : File_Reference;
319 -- Do we have a directory name as well?
321 if File_Name /= Base then
322 Dir_Acc := new String'(Dir);
325 Ref := File_HTable.Get (Base'Unchecked_Access);
327 Ref := new File_Record'
328 (File => new String'(Base),
332 Emit_Warning => Emit_Warning,
333 Gnatchop_File => new String'(Gnatchop_File),
334 Gnatchop_Offset => Gnatchop_Offset,
336 File_HTable.Set (Ref);
340 -- Keep a separate list for faster access
346 end Add_To_Xref_File;
353 (File : File_Reference;
358 File.Lines := new Ref_In_File'(Line => Line,
368 (Declaration : in out Declaration_Reference;
372 File_Ref : File_Reference)
375 Declaration.Par_Symbol :=
377 (File_Ref, Symbol, Line, Column,
379 Symbol_Match => False);
386 procedure Add_Reference
387 (Declaration : Declaration_Reference;
388 File_Ref : File_Reference;
391 Ref_Type : Character;
392 Labels_As_Ref : Boolean)
398 when 'b' | 'c' | 'm' | 'r' | 'R' | 'i' | ' ' | 'x' =>
402 if not Labels_As_Ref then
406 when '=' | '<' | '>' | '^' =>
408 -- Create a dummy declaration in the table to report it as a
409 -- parameter. Note that the current declaration for the subprogram
410 -- comes before the declaration of the parameter.
413 Key : constant String :=
414 Key_From_Ref (File_Ref, Line, Column);
415 New_Decl : Declaration_Reference;
418 New_Decl := new Declaration_Record'
421 Key => new String'(Key),
423 Is_Parameter => True,
431 Entities_HTable.Set (New_Decl);
432 Entities_Count := Entities_Count + 1;
435 when 'e' | 'z' | 't' | 'p' | 'P' | 'k' | 'd' =>
439 Ada.Text_IO.Put_Line ("Unknown reference type: " & Ref_Type);
443 New_Ref := new Reference_Record'
450 -- We can insert the reference in the list directly, since all
451 -- the references will appear only once in the ALI file
452 -- corresponding to the file where they are referenced.
453 -- This saves a lot of time compared to checking the list to check
458 New_Ref.Next := Declaration.Body_Ref;
459 Declaration.Body_Ref := New_Ref;
461 when 'r' | 'R' | 'i' | 'l' | ' ' | 'x' | 'w' =>
462 New_Ref.Next := Declaration.Ref_Ref;
463 Declaration.Ref_Ref := New_Ref;
466 New_Ref.Next := Declaration.Modif_Ref;
467 Declaration.Modif_Ref := New_Ref;
473 if not Declaration.Match then
474 Declaration.Match := Match (File_Ref, Line, Column);
477 if Declaration.Match then
478 Longest_File_Name_In_Table :=
479 Natural'Max (File_Ref.File'Length, Longest_File_Name_In_Table);
487 function ALI_File_Name (Ada_File_Name : String) return String is
489 -- ??? Should ideally be based on the naming scheme defined in
492 Index : constant Natural :=
493 Ada.Strings.Fixed.Index
494 (Ada_File_Name, ".", Going => Ada.Strings.Backward);
498 return Ada_File_Name (Ada_File_Name'First .. Index) & "ali";
500 return Ada_File_Name & ".ali";
508 function Is_Less_Than (Ref1, Ref2 : Reference) return Boolean is
512 elsif Ref2 = null then
516 if Ref1.File.File.all < Ref2.File.File.all then
519 elsif Ref1.File.File.all = Ref2.File.File.all then
520 return (Ref1.Line < Ref2.Line
521 or else (Ref1.Line = Ref2.Line
522 and then Ref1.Column < Ref2.Column));
532 function Is_Less_Than (Decl1, Decl2 : Declaration_Reference) return Boolean
534 -- We cannot store the data case-insensitive in the table,
535 -- since we wouldn't be able to find the right casing for the
538 S1 : constant String := To_Lower (Decl1.Symbol);
539 S2 : constant String := To_Lower (Decl2.Symbol);
548 return Decl1.Key.all < Decl2.Key.all;
551 -------------------------
552 -- Create_Project_File --
553 -------------------------
555 procedure Create_Project_File (Name : String) is
556 Obj_Dir : Unbounded_String := Null_Unbounded_String;
557 Src_Dir : Unbounded_String := Null_Unbounded_String;
558 Build_Dir : GNAT.OS_Lib.String_Access := new String'("");
562 File_Name : aliased String := Name & ASCII.NUL;
565 -- Read the size of the file
567 F := Open_Read (File_Name'Address, Text);
569 -- Project file not found
571 if F /= Invalid_FD then
572 Len := Positive (File_Length (F));
575 Buffer : String (1 .. Len);
576 Index : Positive := Buffer'First;
580 Len := Read (F, Buffer'Address, Len);
583 -- First, look for Build_Dir, since all the source and object
584 -- path are relative to it.
586 while Index <= Buffer'Last loop
588 -- Find the end of line
591 while Last <= Buffer'Last
592 and then Buffer (Last) /= ASCII.LF
593 and then Buffer (Last) /= ASCII.CR
598 if Index <= Buffer'Last - 9
599 and then Buffer (Index .. Index + 9) = "build_dir="
603 and then (Buffer (Index) = ' '
604 or else Buffer (Index) = ASCII.HT)
610 Build_Dir := new String'(Buffer (Index .. Last - 1));
615 -- In case we had a ASCII.CR/ASCII.LF end of line, skip the
618 if Index <= Buffer'Last
619 and then Buffer (Index) = ASCII.LF
625 -- Now parse the source and object paths
627 Index := Buffer'First;
628 while Index <= Buffer'Last loop
630 -- Find the end of line
633 while Last <= Buffer'Last
634 and then Buffer (Last) /= ASCII.LF
635 and then Buffer (Last) /= ASCII.CR
640 if Index <= Buffer'Last - 7
641 and then Buffer (Index .. Index + 7) = "src_dir="
643 Append (Src_Dir, Normalize_Pathname
644 (Name => Ada.Strings.Fixed.Trim
645 (Buffer (Index + 8 .. Last - 1), Ada.Strings.Both),
646 Directory => Build_Dir.all) & Path_Separator);
648 elsif Index <= Buffer'Last - 7
649 and then Buffer (Index .. Index + 7) = "obj_dir="
651 Append (Obj_Dir, Normalize_Pathname
652 (Name => Ada.Strings.Fixed.Trim
653 (Buffer (Index + 8 .. Last - 1), Ada.Strings.Both),
654 Directory => Build_Dir.all) & Path_Separator);
657 -- In case we had a ASCII.CR/ASCII.LF end of line, skip the
661 if Index <= Buffer'Last
662 and then Buffer (Index) = ASCII.LF
670 Osint.Add_Default_Search_Dirs;
673 Src : constant String := Parse_Gnatls_Src;
674 Obj : constant String := Parse_Gnatls_Obj;
677 Directories := new Project_File'
678 (Src_Dir_Length => Length (Src_Dir) + Src'Length,
679 Obj_Dir_Length => Length (Obj_Dir) + Obj'Length,
680 Src_Dir => To_String (Src_Dir) & Src,
681 Obj_Dir => To_String (Obj_Dir) & Obj,
684 Last_Obj_Dir_Start => 0);
688 end Create_Project_File;
690 ---------------------
691 -- Current_Obj_Dir --
692 ---------------------
694 function Current_Obj_Dir return String is
696 return Directories.Obj_Dir
697 (Directories.Last_Obj_Dir_Start .. Directories.Obj_Dir_Index - 2);
704 function Get_Column (Decl : Declaration_Reference) return String is
706 return Ada.Strings.Fixed.Trim (Natural'Image (Decl.Decl.Column),
710 function Get_Column (Ref : Reference) return String is
712 return Ada.Strings.Fixed.Trim (Natural'Image (Ref.Column),
716 ---------------------
717 -- Get_Declaration --
718 ---------------------
720 function Get_Declaration
721 (File_Ref : File_Reference;
724 return Declaration_Reference
726 Key : aliased constant String := Key_From_Ref (File_Ref, Line, Column);
729 return Entities_HTable.Get (Key'Unchecked_Access);
732 ----------------------
733 -- Get_Emit_Warning --
734 ----------------------
736 function Get_Emit_Warning (File : File_Reference) return Boolean is
738 return File.Emit_Warning;
739 end Get_Emit_Warning;
746 (Decl : Declaration_Reference;
747 With_Dir : Boolean := False) return String
750 return Get_File (Decl.Decl.File, With_Dir);
755 With_Dir : Boolean := False) return String
758 return Get_File (Ref.File, With_Dir);
762 (File : File_Reference;
763 With_Dir : Boolean := False;
764 Strip : Natural := 0) return String
766 Tmp : GNAT.OS_Lib.String_Access;
768 function Internal_Strip (Full_Name : String) return String;
769 -- Internal function to process the Strip parameter
775 function Internal_Strip (Full_Name : String) return String is
777 Extension_Start : Natural;
785 -- Isolate the file extension
787 Extension_Start := Full_Name'Last;
788 while Extension_Start >= Full_Name'First
789 and then Full_Name (Extension_Start) /= '.'
791 Extension_Start := Extension_Start - 1;
794 -- Strip the right number of subunit_names
797 Unit_End := Extension_Start - 1;
798 while Unit_End >= Full_Name'First
801 if Full_Name (Unit_End) = '-' then
805 Unit_End := Unit_End - 1;
808 if Unit_End < Full_Name'First then
811 return Full_Name (Full_Name'First .. Unit_End)
812 & Full_Name (Extension_Start .. Full_Name'Last);
816 -- Start of processing for Get_File;
819 -- If we do not want the full path name
822 return Internal_Strip (File.File.all);
825 if File.Dir = null then
826 if Ada.Strings.Fixed.Tail (File.File.all, 3) = "ali" then
827 Tmp := Locate_Regular_File
828 (Internal_Strip (File.File.all), Directories.Obj_Dir);
830 Tmp := Locate_Regular_File
831 (File.File.all, Directories.Src_Dir);
835 File.Dir := new String'("");
837 File.Dir := new String'(Dir_Name (Tmp.all));
842 return Internal_Strip (File.Dir.all & File.File.all);
849 function Get_File_Ref (Ref : Reference) return File_Reference is
854 -----------------------
855 -- Get_Gnatchop_File --
856 -----------------------
858 function Get_Gnatchop_File
859 (File : File_Reference;
860 With_Dir : Boolean := False)
864 if File.Gnatchop_File.all = "" then
865 return Get_File (File, With_Dir);
867 return File.Gnatchop_File.all;
869 end Get_Gnatchop_File;
871 function Get_Gnatchop_File
873 With_Dir : Boolean := False)
877 return Get_Gnatchop_File (Ref.File, With_Dir);
878 end Get_Gnatchop_File;
880 function Get_Gnatchop_File
881 (Decl : Declaration_Reference;
882 With_Dir : Boolean := False)
886 return Get_Gnatchop_File (Decl.Decl.File, With_Dir);
887 end Get_Gnatchop_File;
893 function Get_Line (Decl : Declaration_Reference) return String is
895 return Ada.Strings.Fixed.Trim (Natural'Image (Decl.Decl.Line),
899 function Get_Line (Ref : Reference) return String is
901 return Ada.Strings.Fixed.Trim (Natural'Image (Ref.Line),
910 (Decl : Declaration_Reference)
911 return Declaration_Reference
914 return Decl.Par_Symbol;
917 ---------------------
918 -- Get_Source_Line --
919 ---------------------
921 function Get_Source_Line (Ref : Reference) return String is
923 if Ref.Source_Line /= null then
924 return Ref.Source_Line.all;
930 function Get_Source_Line (Decl : Declaration_Reference) return String is
932 if Decl.Decl.Source_Line /= null then
933 return Decl.Decl.Source_Line.all;
943 function Get_Symbol (Decl : Declaration_Reference) return String is
952 function Get_Type (Decl : Declaration_Reference) return Character is
954 return Decl.Decl_Type;
961 procedure Sort (Arr : in out Reference_Array) is
964 function Lt (Op1, Op2 : Natural) return Boolean;
965 procedure Move (From, To : Natural);
966 -- See GNAT.Heap_Sort_G
972 function Lt (Op1, Op2 : Natural) return Boolean is
975 return Is_Less_Than (Tmp, Arr (Op2));
977 return Is_Less_Than (Arr (Op1), Tmp);
979 return Is_Less_Than (Arr (Op1), Arr (Op2));
987 procedure Move (From, To : Natural) is
994 Arr (To) := Arr (From);
998 package Ref_Sort is new GNAT.Heap_Sort_G (Move, Lt);
1000 -- Start of processing for Sort
1003 Ref_Sort.Sort (Arr'Last);
1006 -----------------------
1007 -- Grep_Source_Files --
1008 -----------------------
1010 procedure Grep_Source_Files is
1011 Length : Natural := 0;
1012 Decl : Declaration_Reference := Entities_HTable.Get_First;
1013 Arr : Reference_Array_Access;
1015 End_Index : Natural;
1016 Current_File : File_Reference;
1017 Current_Line : Cst_String_Access;
1018 Buffer : GNAT.OS_Lib.String_Access;
1023 -- Create a temporary array, where all references will be
1024 -- sorted by files. This way, we only have to read the source
1027 while Decl /= null loop
1029 -- Add 1 for the declaration itself
1031 Length := Length + References_Count (Decl, True, True, True) + 1;
1032 Decl := Entities_HTable.Get_Next;
1035 Arr := new Reference_Array (1 .. Length);
1038 Decl := Entities_HTable.Get_First;
1039 while Decl /= null loop
1040 Store_References (Decl, True, True, True, True, Arr.all, Index);
1041 Decl := Entities_HTable.Get_Next;
1046 -- Now traverse the whole array and find the appropriate source
1049 for R in Arr'Range loop
1052 if Ref.File /= Current_File then
1055 Read_File (Get_File (Ref.File, With_Dir => True), Buffer);
1056 End_Index := Buffer'First - 1;
1059 when Ada.Text_IO.Name_Error | Ada.Text_IO.End_Error =>
1060 Line := Natural'Last;
1062 Current_File := Ref.File;
1065 if Ref.Line > Line then
1067 -- Do not free Current_Line, it is referenced by the last
1068 -- Ref we processed.
1071 Index := End_Index + 1;
1074 End_Index := End_Index + 1;
1075 exit when End_Index > Buffer'Last
1076 or else Buffer (End_Index) = ASCII.LF;
1079 -- Skip spaces at beginning of line
1081 while Index < End_Index and then
1082 (Buffer (Index) = ' ' or else Buffer (Index) = ASCII.HT)
1088 exit when Ref.Line = Line;
1091 Current_Line := new String'(Buffer (Index .. End_Index - 1));
1094 Ref.Source_Line := Current_Line;
1099 end Grep_Source_Files;
1106 (File_Name : String;
1107 Contents : out GNAT.OS_Lib.String_Access)
1109 Name_0 : constant String := File_Name & ASCII.NUL;
1110 FD : constant File_Descriptor := Open_Read (Name_0'Address, Binary);
1114 if FD = Invalid_FD then
1115 raise Ada.Text_IO.Name_Error;
1118 -- Include room for EOF char
1120 Length := Natural (File_Length (FD));
1123 Buffer : String (1 .. Length + 1);
1124 This_Read : Integer;
1125 Read_Ptr : Natural := 1;
1129 This_Read := Read (FD,
1130 A => Buffer (Read_Ptr)'Address,
1131 N => Length + 1 - Read_Ptr);
1132 Read_Ptr := Read_Ptr + Integer'Max (This_Read, 0);
1133 exit when This_Read <= 0;
1136 Buffer (Read_Ptr) := EOF;
1137 Contents := new String'(Buffer (1 .. Read_Ptr));
1139 -- Things are not simple on VMS due to the plethora of file types
1140 -- and organizations. It seems clear that there shouldn't be more
1141 -- bytes read than are contained in the file though.
1143 if (Hostparm.OpenVMS and then Read_Ptr > Length + 1)
1144 or else (not Hostparm.OpenVMS and then Read_Ptr /= Length + 1)
1146 raise Ada.Text_IO.End_Error;
1153 -----------------------
1154 -- Longest_File_Name --
1155 -----------------------
1157 function Longest_File_Name return Natural is
1159 return Longest_File_Name_In_Table;
1160 end Longest_File_Name;
1167 (File : File_Reference;
1172 Ref : Ref_In_File_Ptr := File.Lines;
1175 while Ref /= null loop
1176 if (Ref.Line = 0 or else Ref.Line = Line)
1177 and then (Ref.Column = 0 or else Ref.Column = Column)
1192 function Match (Decl : Declaration_Reference) return Boolean is
1201 function Next (E : File_Reference) return File_Reference is
1206 function Next (E : Declaration_Reference) return Declaration_Reference is
1215 function Next_Obj_Dir return String is
1216 First : constant Integer := Directories.Obj_Dir_Index;
1220 Last := Directories.Obj_Dir_Index;
1222 if Last > Directories.Obj_Dir_Length then
1223 return String'(1 .. 0 => ' ');
1226 while Directories.Obj_Dir (Last) /= Path_Separator loop
1230 Directories.Obj_Dir_Index := Last + 1;
1231 Directories.Last_Obj_Dir_Start := First;
1232 return Directories.Obj_Dir (First .. Last - 1);
1235 -------------------------
1236 -- Next_Unvisited_File --
1237 -------------------------
1239 function Next_Unvisited_File return File_Reference is
1240 procedure Unchecked_Free is new Ada.Unchecked_Deallocation
1241 (Unvisited_Files_Record, Unvisited_Files_Access);
1243 Ref : File_Reference;
1244 Tmp : Unvisited_Files_Access;
1247 if Unvisited_Files = null then
1250 Tmp := Unvisited_Files;
1251 Ref := Unvisited_Files.File;
1252 Unvisited_Files := Unvisited_Files.Next;
1253 Unchecked_Free (Tmp);
1256 end Next_Unvisited_File;
1258 ----------------------
1259 -- Parse_Gnatls_Src --
1260 ----------------------
1262 function Parse_Gnatls_Src return String is
1267 for J in 1 .. Osint.Nb_Dir_In_Src_Search_Path loop
1268 if Osint.Dir_In_Src_Search_Path (J)'Length = 0 then
1269 Length := Length + 2;
1271 Length := Length + Osint.Dir_In_Src_Search_Path (J)'Length + 1;
1276 Result : String (1 .. Length);
1281 for J in 1 .. Osint.Nb_Dir_In_Src_Search_Path loop
1282 if Osint.Dir_In_Src_Search_Path (J)'Length = 0 then
1283 Result (L .. L + 1) := "." & Path_Separator;
1287 Result (L .. L + Osint.Dir_In_Src_Search_Path (J)'Length - 1) :=
1288 Osint.Dir_In_Src_Search_Path (J).all;
1289 L := L + Osint.Dir_In_Src_Search_Path (J)'Length;
1290 Result (L) := Path_Separator;
1297 end Parse_Gnatls_Src;
1299 ----------------------
1300 -- Parse_Gnatls_Obj --
1301 ----------------------
1303 function Parse_Gnatls_Obj return String is
1308 for J in 1 .. Osint.Nb_Dir_In_Obj_Search_Path loop
1309 if Osint.Dir_In_Obj_Search_Path (J)'Length = 0 then
1310 Length := Length + 2;
1312 Length := Length + Osint.Dir_In_Obj_Search_Path (J)'Length + 1;
1317 Result : String (1 .. Length);
1322 for J in 1 .. Osint.Nb_Dir_In_Obj_Search_Path loop
1323 if Osint.Dir_In_Obj_Search_Path (J)'Length = 0 then
1324 Result (L .. L + 1) := "." & Path_Separator;
1327 Result (L .. L + Osint.Dir_In_Obj_Search_Path (J)'Length - 1) :=
1328 Osint.Dir_In_Obj_Search_Path (J).all;
1329 L := L + Osint.Dir_In_Obj_Search_Path (J)'Length;
1330 Result (L) := Path_Separator;
1337 end Parse_Gnatls_Obj;
1343 procedure Reset_Obj_Dir is
1345 Directories.Obj_Dir_Index := 1;
1348 -----------------------
1349 -- Set_Default_Match --
1350 -----------------------
1352 procedure Set_Default_Match (Value : Boolean) is
1354 Default_Match := Value;
1355 end Set_Default_Match;
1361 procedure Free (Str : in out Cst_String_Access) is
1362 function Convert is new Ada.Unchecked_Conversion
1363 (Cst_String_Access, GNAT.OS_Lib.String_Access);
1365 S : GNAT.OS_Lib.String_Access := Convert (Str);
1372 ---------------------
1373 -- Reset_Directory --
1374 ---------------------
1376 procedure Reset_Directory (File : File_Reference) is
1379 end Reset_Directory;
1385 procedure Set_Unvisited (File_Ref : File_Reference) is
1386 F : constant String := Get_File (File_Ref, With_Dir => False);
1389 File_Ref.Visited := False;
1391 -- ??? Do not add a source file to the list. This is true at
1392 -- least for gnatxref, and probably for gnatfind as well
1395 and then F (F'Last - 3 .. F'Last) = ".ali"
1397 Unvisited_Files := new Unvisited_Files_Record'
1399 Next => Unvisited_Files);
1403 ----------------------
1404 -- Get_Declarations --
1405 ----------------------
1407 function Get_Declarations
1408 (Sorted : Boolean := True)
1409 return Declaration_Array_Access
1411 Arr : constant Declaration_Array_Access :=
1412 new Declaration_Array (1 .. Entities_Count);
1413 Decl : Declaration_Reference := Entities_HTable.Get_First;
1414 Index : Natural := Arr'First;
1415 Tmp : Declaration_Reference;
1417 procedure Move (From : Natural; To : Natural);
1418 function Lt (Op1, Op2 : Natural) return Boolean;
1419 -- See GNAT.Heap_Sort_G
1425 function Lt (Op1, Op2 : Natural) return Boolean is
1428 return Is_Less_Than (Tmp, Arr (Op2));
1430 return Is_Less_Than (Arr (Op1), Tmp);
1432 return Is_Less_Than (Arr (Op1), Arr (Op2));
1440 procedure Move (From : Natural; To : Natural) is
1447 Arr (To) := Arr (From);
1451 package Decl_Sort is new GNAT.Heap_Sort_G (Move, Lt);
1453 -- Start of processing for Get_Declarations
1456 while Decl /= null loop
1457 Arr (Index) := Decl;
1459 Decl := Entities_HTable.Get_Next;
1462 if Sorted and then Arr'Length /= 0 then
1463 Decl_Sort.Sort (Entities_Count);
1467 end Get_Declarations;
1469 ----------------------
1470 -- References_Count --
1471 ----------------------
1473 function References_Count
1474 (Decl : Declaration_Reference;
1475 Get_Reads : Boolean := False;
1476 Get_Writes : Boolean := False;
1477 Get_Bodies : Boolean := False)
1480 function List_Length (E : Reference) return Natural;
1481 -- Return the number of references in E
1487 function List_Length (E : Reference) return Natural is
1489 E1 : Reference := E;
1492 while E1 /= null loop
1500 Length : Natural := 0;
1502 -- Start of processing for References_Count
1506 Length := List_Length (Decl.Ref_Ref);
1510 Length := Length + List_Length (Decl.Modif_Ref);
1514 Length := Length + List_Length (Decl.Body_Ref);
1518 end References_Count;
1520 ----------------------
1521 -- Store_References --
1522 ----------------------
1524 procedure Store_References
1525 (Decl : Declaration_Reference;
1526 Get_Writes : Boolean := False;
1527 Get_Reads : Boolean := False;
1528 Get_Bodies : Boolean := False;
1529 Get_Declaration : Boolean := False;
1530 Arr : in out Reference_Array;
1531 Index : in out Natural)
1533 procedure Add (List : Reference);
1534 -- Add all the references in List to Arr
1540 procedure Add (List : Reference) is
1541 E : Reference := List;
1543 while E /= null loop
1550 -- Start of processing for Store_References
1553 if Get_Declaration then
1562 Add (Decl.Modif_Ref);
1566 Add (Decl.Body_Ref);
1568 end Store_References;
1570 --------------------
1571 -- Get_References --
1572 --------------------
1574 function Get_References
1575 (Decl : Declaration_Reference;
1576 Get_Reads : Boolean := False;
1577 Get_Writes : Boolean := False;
1578 Get_Bodies : Boolean := False)
1579 return Reference_Array_Access
1581 Length : constant Natural :=
1582 References_Count (Decl, Get_Reads, Get_Writes, Get_Bodies);
1584 Arr : constant Reference_Array_Access :=
1585 new Reference_Array (1 .. Length);
1587 Index : Natural := Arr'First;
1592 Get_Writes => Get_Writes,
1593 Get_Reads => Get_Reads,
1594 Get_Bodies => Get_Bodies,
1595 Get_Declaration => False,
1599 if Arr'Length /= 0 then
1610 procedure Free (Arr : in out Reference_Array_Access) is
1611 procedure Internal is new Ada.Unchecked_Deallocation
1612 (Reference_Array, Reference_Array_Access);
1621 function Is_Parameter (Decl : Declaration_Reference) return Boolean is
1623 return Decl.Is_Parameter;