1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
10 -- Copyright (C) 1998-2002 Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). --
25 ------------------------------------------------------------------------------
28 with Unchecked_Deallocation
;
30 with Ada
.IO_Exceptions
;
31 with Ada
.Strings
.Fixed
;
34 with Ada
.Strings
.Unbounded
; use Ada
.Strings
.Unbounded
;
37 with GNAT
.OS_Lib
; use GNAT
.OS_Lib
;
38 with GNAT
.Directory_Operations
; use GNAT
.Directory_Operations
;
40 package body Xr_Tabls
is
42 function Base_File_Name
(File
: String) return String;
43 -- Return the base file name for File (ie not including the directory)
45 function Dir_Name
(File
: String; Base
: String := "") return String;
46 -- Return the directory name of File, or "" if there is no directory part
48 -- This includes the last separator at the end, and always return an
49 -- absolute path name (directories are relative to Base, or the current
50 -- directory if Base is "")
52 Dir_Sep
: Character renames GNAT
.OS_Lib
.Directory_Separator
;
55 Entities
: Entity_Table
;
56 Directories
: Project_File_Ptr
;
57 Default_Match
: Boolean := False;
63 function Add_Declaration
64 (File_Ref
: File_Reference
;
68 Decl_Type
: Character)
69 return Declaration_Reference
71 The_Entities
: Declaration_Reference
:= Entities
.Table
;
72 New_Decl
: Declaration_Reference
;
73 Result
: Compare_Result
;
74 Prev
: Declaration_Reference
:= null;
77 -- Check if the identifier already exists in the table
79 while The_Entities
/= null loop
80 Result
:= Compare
(The_Entities
, File_Ref
, Line
, Column
, Symbol
);
81 exit when Result
= GreaterThan
;
83 if Result
= Equal
then
88 The_Entities
:= The_Entities
.Next
;
91 -- Insert the Declaration in the table
94 new Declaration_Record
'
95 (Symbol_Length => Symbol'Length,
97 Decl => (File => File_Ref,
100 Source_Line => Null_Unbounded_String,
102 Decl_Type => Decl_Type,
106 Match => Default_Match
107 or else Match (File_Ref, Line, Column),
112 New_Decl.Next := Entities.Table;
113 Entities.Table := New_Decl;
115 New_Decl.Next := Prev.Next;
116 Prev.Next := New_Decl;
119 if New_Decl.Match then
120 Files.Longest_Name := Natural'Max (File_Ref.File'Length,
127 ----------------------
128 -- Add_To_Xref_File --
129 ----------------------
131 procedure Add_To_Xref_File
133 File_Existed : out Boolean;
134 Ref : out File_Reference;
135 Visited : Boolean := True;
136 Emit_Warning : Boolean := False;
137 Gnatchop_File : String := "";
138 Gnatchop_Offset : Integer := 0)
140 The_Files : File_Reference := Files.Table;
141 Base : constant String := Base_File_Name (File_Name);
142 Dir : constant String := Xr_Tabls.Dir_Name (File_Name);
143 Dir_Acc : String_Access := null;
146 -- Do we have a directory name as well?
149 Dir_Acc := new String' (Dir
);
152 -- Check if the file already exists in the table
154 while The_Files
/= null loop
156 if The_Files
.File
= File_Name
then
157 File_Existed
:= True;
162 The_Files
:= The_Files
.Next
;
165 Ref
:= new File_Record
'
166 (File_Length => Base'Length,
171 Emit_Warning => Emit_Warning,
172 Gnatchop_File => new String' (Gnatchop_File
),
173 Gnatchop_Offset
=> Gnatchop_Offset
,
174 Next
=> Files
.Table
);
176 File_Existed
:= False;
177 end Add_To_Xref_File
;
184 (File
: File_Reference
;
189 File
.Lines
:= new Ref_In_File
'(Line => Line,
199 (Declaration : in out Declaration_Reference;
203 File_Ref : File_Reference)
206 Declaration.Par_Symbol := new Declaration_Record'
207 (Symbol_Length
=> Symbol
'Length,
209 Decl
=> (File
=> File_Ref
,
212 Source_Line
=> Null_Unbounded_String
,
227 procedure Add_Reference
228 (Declaration
: Declaration_Reference
;
229 File_Ref
: File_Reference
;
232 Ref_Type
: Character)
234 procedure Free
is new Unchecked_Deallocation
235 (Reference_Record
, Reference
);
238 Prev
: Reference
:= null;
239 Result
: Compare_Result
;
240 New_Ref
: Reference
:= new Reference_Record
'
244 Source_Line => Null_Unbounded_String,
250 Ref := Declaration.Body_Ref;
252 when 'r
' | 'i
' | 'l
' | ' ' | 'x
' =>
253 Ref := Declaration.Ref_Ref;
256 Ref := Declaration.Modif_Ref;
258 when 'e
' | 't
' | 'p
' =>
262 Ada.Text_IO.Put_Line ("Unknown reference type: " & Ref_Type);
266 -- Check if the reference already exists
268 while Ref /= null loop
269 Result := Compare (New_Ref, Ref);
270 exit when Result = LessThan;
272 if Result = Equal then
281 -- Insert it in the list
284 New_Ref.Next := Prev.Next;
285 Prev.Next := New_Ref;
290 New_Ref.Next := Declaration.Body_Ref;
291 Declaration.Body_Ref := New_Ref;
293 when 'r
' | 'i
' | 'l
' | ' ' | 'x
' =>
294 New_Ref.Next := Declaration.Ref_Ref;
295 Declaration.Ref_Ref := New_Ref;
298 New_Ref.Next := Declaration.Modif_Ref;
299 Declaration.Modif_Ref := New_Ref;
306 if not Declaration.Match then
307 Declaration.Match := Match (File_Ref, Line, Column);
310 if Declaration.Match then
311 Files.Longest_Name := Natural'Max (File_Ref.File'Length,
320 function ALI_File_Name (Ada_File_Name : String) return String is
321 Index : Natural := Ada.Strings.Fixed.Index
322 (Ada_File_Name, ".", Going => Ada.Strings.Backward);
326 return Ada_File_Name (Ada_File_Name'First .. Index)
329 return Ada_File_Name & ".ali";
337 function Base_File_Name (File : String) return String is
339 for J in reverse File'Range loop
340 if File (J) = '/' or else File (J) = Dir_Sep then
341 return File (J + 1 .. File'Last);
355 return Compare_Result
360 elsif Ref2 = null then
364 if Ref1.File.File < Ref2.File.File then
367 elsif Ref1.File.File = Ref2.File.File then
368 if Ref1.Line < Ref2.Line then
371 elsif Ref1.Line = Ref2.Line then
372 if Ref1.Column < Ref2.Column then
374 elsif Ref1.Column = Ref2.Column then
394 (Decl1 : Declaration_Reference;
395 File2 : File_Reference;
399 return Compare_Result
406 if Decl1.Symbol < Symb2 then
408 elsif Decl1.Symbol > Symb2 then
412 if Decl1.Decl.File.File < Get_File (File2) then
415 elsif Decl1.Decl.File.File = Get_File (File2) then
416 if Decl1.Decl.Line < Line2 then
419 elsif Decl1.Decl.Line = Line2 then
420 if Decl1.Decl.Column < Col2 then
423 elsif Decl1.Decl.Column = Col2 then
439 -------------------------
440 -- Create_Project_File --
441 -------------------------
443 procedure Create_Project_File
446 use Ada.Strings.Unbounded;
448 Obj_Dir : Unbounded_String := Null_Unbounded_String;
449 Src_Dir : Unbounded_String := Null_Unbounded_String;
450 Build_Dir : Unbounded_String;
452 Gnatls_Src_Cache : Unbounded_String;
453 Gnatls_Obj_Cache : Unbounded_String;
457 File_Name : aliased String := Name & ASCII.NUL;
461 -- Read the size of the file
462 F := Open_Read (File_Name'Address, Text);
464 -- Project file not found
465 if F /= Invalid_FD then
466 Len := Positive (File_Length (F));
469 Buffer : String (1 .. Len);
470 Index : Positive := Buffer'First;
473 Len := Read (F, Buffer'Address, Len);
476 -- First, look for Build_Dir, since all the source and object
477 -- path are relative to it.
479 while Index <= Buffer'Last loop
481 -- find the end of line
484 while Last <= Buffer'Last
485 and then Buffer (Last) /= ASCII.LF
486 and then Buffer (Last) /= ASCII.CR
491 if Index <= Buffer'Last - 9
492 and then Buffer (Index .. Index + 9) = "build_dir="
496 and then (Buffer (Index) = ' '
497 or else Buffer (Index) = ASCII.HT)
503 To_Unbounded_String (Buffer (Index .. Last - 1));
504 if Buffer (Last - 1) /= Dir_Sep then
505 Append (Build_Dir, Dir_Sep);
511 -- In case we had a ASCII.CR/ASCII.LF end of line, skip the
514 if Index <= Buffer'Last
515 and then Buffer (Index) = ASCII.LF
521 -- Now parse the source and object paths
523 Index := Buffer'First;
524 while Index <= Buffer'Last loop
526 -- find the end of line
529 while Last <= Buffer'Last
530 and then Buffer (Last) /= ASCII.LF
531 and then Buffer (Last) /= ASCII.CR
536 if Index <= Buffer'Last - 7
537 and then Buffer (Index .. Index + 7) = "src_dir="
540 S : String := Ada.Strings.Fixed.Trim
541 (Buffer (Index + 8 .. Last - 1), Ada.Strings.Both);
543 -- A relative directory ?
544 if S (S'First) /= Dir_Sep then
545 Append (Src_Dir, Build_Dir);
548 if S (S'Last) = Dir_Sep then
549 Append (Src_Dir, S & " ");
551 Append (Src_Dir, S & Dir_Sep & " ");
555 elsif Index <= Buffer'Last - 7
556 and then Buffer (Index .. Index + 7) = "obj_dir="
559 S : String := Ada.Strings.Fixed.Trim
560 (Buffer (Index + 8 .. Last - 1), Ada.Strings.Both);
562 -- A relative directory ?
563 if S (S'First) /= Dir_Sep then
564 Append (Obj_Dir, Build_Dir);
567 if S (S'Last) = Dir_Sep then
568 Append (Obj_Dir, S & " ");
570 Append (Obj_Dir, S & Dir_Sep & " ");
575 -- In case we had a ASCII.CR/ASCII.LF end of line, skip the
579 if Index <= Buffer'Last
580 and then Buffer (Index) = ASCII.LF
588 Parse_Gnatls (Gnatls_Src_Cache, Gnatls_Obj_Cache);
590 Directories := new Project_File'
591 (Src_Dir_Length
=> Length
(Src_Dir
) + Length
(Gnatls_Src_Cache
),
592 Obj_Dir_Length
=> Length
(Obj_Dir
) + Length
(Gnatls_Obj_Cache
),
593 Src_Dir
=> To_String
(Src_Dir
& Gnatls_Src_Cache
),
594 Obj_Dir
=> To_String
(Obj_Dir
& Gnatls_Obj_Cache
),
597 Last_Obj_Dir_Start
=> 0);
598 end Create_Project_File
;
600 ---------------------
601 -- Current_Obj_Dir --
602 ---------------------
604 function Current_Obj_Dir
return String is
606 return Directories
.Obj_Dir
(Directories
.Last_Obj_Dir_Start
607 .. Directories
.Obj_Dir_Index
- 2);
614 function Dir_Name
(File
: String; Base
: String := "") return String is
616 for J
in reverse File
'Range loop
617 if File
(J
) = '/' or else File
(J
) = Dir_Sep
then
619 -- Is this an absolute directory ?
620 if File
(File
'First) = '/'
621 or else File
(File
'First) = Dir_Sep
623 return File
(File
'First .. J
);
625 -- Else do we know the base directory ?
626 elsif Base
/= "" then
627 return Base
& File
(File
'First .. J
);
632 pragma Import
(C
, Max_Path
, "__gnat_max_path_len");
634 Base2
: Dir_Name_Str
(1 .. Max_Path
);
637 Get_Current_Dir
(Base2
, Last
);
638 return Base2
(Base2
'First .. Last
) & File
(File
'First .. J
);
650 function Find_ALI_File
(Short_Name
: String) return String is
651 use type Ada
.Strings
.Unbounded
.String_Access
;
652 Old_Obj_Dir
: constant Integer := Directories
.Obj_Dir_Index
;
659 Obj_Dir
: String := Next_Obj_Dir
;
661 exit when Obj_Dir
'Length = 0;
662 if GNAT
.IO_Aux
.File_Exists
(Obj_Dir
& Short_Name
) then
663 Directories
.Obj_Dir_Index
:= Old_Obj_Dir
;
669 -- Finally look in the standard directories
671 Directories
.Obj_Dir_Index
:= Old_Obj_Dir
;
675 ----------------------
676 -- Find_Source_File --
677 ----------------------
679 function Find_Source_File
(Short_Name
: String) return String is
680 use type Ada
.Strings
.Unbounded
.String_Access
;
686 Src_Dir
: String := Next_Src_Dir
;
688 exit when Src_Dir
'Length = 0;
690 if GNAT
.IO_Aux
.File_Exists
(Src_Dir
& Short_Name
) then
696 -- Finally look in the standard directories
699 end Find_Source_File
;
705 function First_Body
(Decl
: Declaration_Reference
) return Reference
is
707 return Decl
.Body_Ref
;
710 -----------------------
711 -- First_Declaration --
712 -----------------------
714 function First_Declaration
return Declaration_Reference
is
716 return Entities
.Table
;
717 end First_Declaration
;
723 function First_Modif
(Decl
: Declaration_Reference
) return Reference
is
725 return Decl
.Modif_Ref
;
728 ---------------------
729 -- First_Reference --
730 ---------------------
732 function First_Reference
(Decl
: Declaration_Reference
) return Reference
is
741 function Get_Column
(Decl
: Declaration_Reference
) return String is
743 return Ada
.Strings
.Fixed
.Trim
(Natural'Image (Decl
.Decl
.Column
),
747 function Get_Column
(Ref
: Reference
) return String is
749 return Ada
.Strings
.Fixed
.Trim
(Natural'Image (Ref
.Column
),
753 ---------------------
754 -- Get_Declaration --
755 ---------------------
757 function Get_Declaration
758 (File_Ref
: File_Reference
;
761 return Declaration_Reference
763 The_Entities
: Declaration_Reference
:= Entities
.Table
;
765 while The_Entities
/= null loop
766 if The_Entities
.Decl
.Line
= Line
767 and then The_Entities
.Decl
.Column
= Column
768 and then The_Entities
.Decl
.File
= File_Ref
772 The_Entities
:= The_Entities
.Next
;
776 return Empty_Declaration
;
779 ----------------------
780 -- Get_Emit_Warning --
781 ----------------------
783 function Get_Emit_Warning
(File
: File_Reference
) return Boolean is
785 return File
.Emit_Warning
;
786 end Get_Emit_Warning
;
793 (Decl
: Declaration_Reference
;
794 With_Dir
: Boolean := False)
798 return Get_File
(Decl
.Decl
.File
, With_Dir
);
803 With_Dir
: Boolean := False)
807 return Get_File
(Ref
.File
, With_Dir
);
811 (File
: File_Reference
;
812 With_Dir
: in Boolean := False;
813 Strip
: Natural := 0)
816 function Internal_Strip
(Full_Name
: String) return String;
817 -- Internal function to process the Strip parameter
823 function Internal_Strip
(Full_Name
: String) return String is
824 Unit_End
, Extension_Start
: Natural;
825 S
: Natural := Strip
;
831 -- Isolate the file extension
833 Extension_Start
:= Full_Name
'Last;
834 while Extension_Start
>= Full_Name
'First
835 and then Full_Name
(Extension_Start
) /= '.'
837 Extension_Start
:= Extension_Start
- 1;
840 -- Strip the right number of subunit_names
842 Unit_End
:= Extension_Start
- 1;
843 while Unit_End
>= Full_Name
'First
846 if Full_Name
(Unit_End
) = '-' then
849 Unit_End
:= Unit_End
- 1;
852 if Unit_End
< Full_Name
'First then
855 return Full_Name
(Full_Name
'First .. Unit_End
)
856 & Full_Name
(Extension_Start
.. Full_Name
'Last);
861 -- If we do not want the full path name
864 return Internal_Strip
(File
.File
);
867 if File
.Dir
= null then
869 if Ada
.Strings
.Fixed
.Tail
(File
.File
, 3) = "ali" then
870 File
.Dir
:= new String'(Find_ALI_File (File.File));
872 File.Dir := new String'(Find_Source_File
(File
.File
));
876 return Internal_Strip
(File
.Dir
.all & File
.File
);
883 function Get_File_Ref
(Ref
: Reference
) return File_Reference
is
888 -----------------------
889 -- Get_Gnatchop_File --
890 -----------------------
892 function Get_Gnatchop_File
893 (File
: File_Reference
; With_Dir
: Boolean := False) return String is
895 if File
.Gnatchop_File
.all = "" then
896 return Get_File
(File
, With_Dir
);
898 return File
.Gnatchop_File
.all;
900 end Get_Gnatchop_File
;
902 -----------------------
903 -- Get_Gnatchop_File --
904 -----------------------
906 function Get_Gnatchop_File
907 (Ref
: Reference
; With_Dir
: Boolean := False) return String is
909 return Get_Gnatchop_File
(Ref
.File
, With_Dir
);
910 end Get_Gnatchop_File
;
912 -----------------------
913 -- Get_Gnatchop_File --
914 -----------------------
916 function Get_Gnatchop_File
917 (Decl
: Declaration_Reference
; With_Dir
: Boolean := False) return String
920 return Get_Gnatchop_File
(Decl
.Decl
.File
, With_Dir
);
921 end Get_Gnatchop_File
;
927 function Get_Line
(Decl
: Declaration_Reference
) return String is
929 return Ada
.Strings
.Fixed
.Trim
(Natural'Image (Decl
.Decl
.Line
),
933 function Get_Line
(Ref
: Reference
) return String is
935 return Ada
.Strings
.Fixed
.Trim
(Natural'Image (Ref
.Line
),
944 (Decl
: Declaration_Reference
)
945 return Declaration_Reference
is
947 return Decl
.Par_Symbol
;
950 ---------------------
951 -- Get_Source_Line --
952 ---------------------
954 function Get_Source_Line
(Ref
: Reference
) return String is
956 return To_String
(Ref
.Source_Line
);
959 function Get_Source_Line
(Decl
: Declaration_Reference
) return String is
961 return To_String
(Decl
.Decl
.Source_Line
);
968 function Get_Symbol
(Decl
: Declaration_Reference
) return String is
977 function Get_Type
(Decl
: Declaration_Reference
) return Character is
979 return Decl
.Decl_Type
;
982 -----------------------
983 -- Grep_Source_Files --
984 -----------------------
986 procedure Grep_Source_Files
is
987 Decl
: Declaration_Reference
:= First_Declaration
;
990 type Simple_Ref_Access
is access Simple_Ref
;
991 type Simple_Ref
is record
993 Next
: Simple_Ref_Access
;
995 List
: Simple_Ref_Access
:= null;
996 -- This structure is used to speed up the parsing of Ada sources:
997 -- Every reference found by parsing the .ali files is inserted in this
998 -- list, sorted by filename and line numbers. This allows avoiding
999 -- parsing a same ada file multiple times
1001 procedure Free
is new Unchecked_Deallocation
1002 (Simple_Ref
, Simple_Ref_Access
);
1003 -- Clear an element of the list
1005 procedure Grep_List
;
1006 -- For each reference in the list, parse the file and find the
1009 procedure Insert_In_Order
(Ref
: Reference
);
1010 -- Insert a new reference in the list, ordered by line numbers
1012 procedure Insert_List_Ref
(First_Ref
: Reference
);
1013 -- Process a list of references
1019 procedure Grep_List
is
1020 Line
: String (1 .. 1024);
1022 File
: Ada
.Text_IO
.File_Type
;
1023 Line_Number
: Natural;
1025 Save_List
: Simple_Ref_Access
:= List
;
1026 Current_File
: File_Reference
;
1029 while List
/= null loop
1031 -- Makes sure we can find and read the file
1033 Current_File
:= List
.Ref
.File
;
1037 Ada
.Text_IO
.Open
(File
,
1038 Ada
.Text_IO
.In_File
,
1039 Get_File
(List
.Ref
, True));
1041 -- Read the file and find every relevant lines
1044 and then List
.Ref
.File
= Current_File
1045 and then not Ada
.Text_IO
.End_Of_File
(File
)
1047 Ada
.Text_IO
.Get_Line
(File
, Line
, Last
);
1048 Line_Number
:= Line_Number
+ 1;
1051 and then Line_Number
= List
.Ref
.Line
1054 -- Skip the leading blanks on the line
1057 while Line
(Pos
) = ' '
1058 or else Line
(Pos
) = ASCII
.HT
1063 List
.Ref
.Source_Line
:=
1064 To_Unbounded_String
(Line
(Pos
.. Last
));
1066 -- Find the next element in the list
1073 Ada
.Text_IO
.Close
(File
);
1075 -- If the Current_File was not found, just skip it
1078 when Ada
.IO_Exceptions
.Name_Error
=>
1082 -- If the line or the file were not found
1085 and then List
.Ref
.File
= Current_File
1094 while Save_List
/= null loop
1096 Save_List
:= Save_List
.Next
;
1101 ---------------------
1102 -- Insert_In_Order --
1103 ---------------------
1105 procedure Insert_In_Order
(Ref
: Reference
) is
1106 Iter
: Simple_Ref_Access
:= List
;
1107 Prev
: Simple_Ref_Access
:= null;
1110 while Iter
/= null loop
1112 -- If we have found the file, sort by lines
1114 if Iter
.Ref
.File
= Ref
.File
then
1117 and then Iter
.Ref
.File
= Ref
.File
1119 if Iter
.Ref
.Line
> Ref
.Line
then
1122 List
:= new Simple_Ref
'(Ref, List);
1124 Prev.Next := new Simple_Ref'(Ref
, Iter
);
1134 List
:= new Simple_Ref
'(Ref, List);
1136 Prev.Next := new Simple_Ref'(Ref
, Iter
);
1146 -- The file was not already in the list, insert it
1148 List
:= new Simple_Ref
'(Ref, List);
1149 end Insert_In_Order;
1151 ---------------------
1152 -- Insert_List_Ref --
1153 ---------------------
1155 procedure Insert_List_Ref (First_Ref : Reference) is
1156 Ref : Reference := First_Ref;
1159 while Ref /= Empty_Reference loop
1160 Insert_In_Order (Ref);
1163 end Insert_List_Ref;
1165 -- Start of processing for Grep_Source_Files
1168 while Decl /= Empty_Declaration loop
1169 Insert_In_Order (Decl.Decl'Access);
1170 Insert_List_Ref (First_Body (Decl));
1171 Insert_List_Ref (First_Reference (Decl));
1172 Insert_List_Ref (First_Modif (Decl));
1173 Decl := Next (Decl);
1177 end Grep_Source_Files;
1179 -----------------------
1180 -- Longest_File_Name --
1181 -----------------------
1183 function Longest_File_Name return Natural is
1185 return Files.Longest_Name;
1186 end Longest_File_Name;
1193 (File : File_Reference;
1198 Ref : Ref_In_File_Ptr := File.Lines;
1201 while Ref /= null loop
1202 if (Ref.Line = 0 or else Ref.Line = Line)
1203 and then (Ref.Column = 0 or else Ref.Column = Column)
1218 function Match (Decl : Declaration_Reference) return Boolean is
1227 function Next (Decl : Declaration_Reference) return Declaration_Reference is
1236 function Next (Ref : Reference) return Reference is
1245 function Next_Obj_Dir return String is
1246 First : Integer := Directories.Obj_Dir_Index;
1247 Last : Integer := Directories.Obj_Dir_Index;
1250 if Last > Directories.Obj_Dir_Length then
1251 return String'(1 .. 0 => ' ');
1254 while Directories
.Obj_Dir
(Last
) /= ' ' loop
1258 Directories
.Obj_Dir_Index
:= Last
+ 1;
1259 Directories
.Last_Obj_Dir_Start
:= First
;
1260 return Directories
.Obj_Dir
(First
.. Last
- 1);
1267 function Next_Src_Dir
return String is
1268 First
: Integer := Directories
.Src_Dir_Index
;
1269 Last
: Integer := Directories
.Src_Dir_Index
;
1272 if Last
> Directories
.Src_Dir_Length
then
1273 return String'(1 .. 0 => ' ');
1276 while Directories.Src_Dir (Last) /= ' ' loop
1280 Directories.Src_Dir_Index := Last + 1;
1281 return Directories.Src_Dir (First .. Last - 1);
1284 -------------------------
1285 -- Next_Unvisited_File --
1286 -------------------------
1288 function Next_Unvisited_File return File_Reference is
1289 The_Files : File_Reference := Files.Table;
1292 while The_Files /= null loop
1293 if not The_Files.Visited then
1294 The_Files.Visited := True;
1298 The_Files := The_Files.Next;
1302 end Next_Unvisited_File;
1308 procedure Parse_Gnatls
1309 (Gnatls_Src_Cache : out Ada.Strings.Unbounded.Unbounded_String;
1310 Gnatls_Obj_Cache : out Ada.Strings.Unbounded.Unbounded_String)
1313 Osint.Add_Default_Search_Dirs;
1315 for J in 1 .. Osint.Nb_Dir_In_Src_Search_Path loop
1316 if Osint.Dir_In_Src_Search_Path (J)'Length = 0 then
1317 Ada.Strings.Unbounded.Append (Gnatls_Src_Cache, "./" & ' ');
1319 Ada.Strings.Unbounded.Append
1320 (Gnatls_Src_Cache, Osint.Dir_In_Src_Search_Path (J).all & ' ');
1324 for J in 1 .. Osint.Nb_Dir_In_Obj_Search_Path loop
1325 if Osint.Dir_In_Obj_Search_Path (J)'Length = 0 then
1326 Ada.Strings.Unbounded.Append (Gnatls_Obj_Cache, "./" & ' ');
1328 Ada.Strings.Unbounded.Append
1329 (Gnatls_Obj_Cache, Osint.Dir_In_Obj_Search_Path (J).all & ' ');
1338 procedure Reset_Obj_Dir is
1340 Directories.Obj_Dir_Index := 1;
1347 procedure Reset_Src_Dir is
1349 Directories.Src_Dir_Index := 1;
1352 -----------------------
1353 -- Set_Default_Match --
1354 -----------------------
1356 procedure Set_Default_Match (Value : Boolean) is
1358 Default_Match := Value;
1359 end Set_Default_Match;
1365 procedure Set_Directory
1366 (File : in File_Reference;
1370 File.Dir := new String'(Dir
);
1377 procedure Set_Unvisited
(File_Ref
: in File_Reference
) is
1378 The_Files
: File_Reference
:= Files
.Table
;
1381 while The_Files
/= null loop
1382 if The_Files
= File_Ref
then
1383 The_Files
.Visited
:= False;
1387 The_Files
:= The_Files
.Next
;