File : prj-util.ads
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- P R J . U T I L --
6 -- --
7 -- S p e c --
8 -- --
9 -- Copyright (C) 2001-2015, 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 -- Utilities for use in processing project files
27
28 package Prj.Util is
29
30 function Executable_Of
31 (Project : Project_Id;
32 Shared : Shared_Project_Tree_Data_Access;
33 Main : File_Name_Type;
34 Index : Int;
35 Ada_Main : Boolean := True;
36 Language : String := "";
37 Include_Suffix : Boolean := True) return File_Name_Type;
38 -- Return the value of the attribute Builder'Executable for file Main in
39 -- the project Project, if it exists. If there is no attribute Executable
40 -- for Main, remove the suffix from Main; then, if the attribute
41 -- Executable_Suffix is specified, add this suffix, otherwise add the
42 -- standard executable suffix for the platform.
43 --
44 -- If Include_Suffix is true, then the ".exe" suffix (or any suffix defined
45 -- in the config) will be added. The suffix defined by the user in his own
46 -- project file is always taken into account. Otherwise, such a suffix is
47 -- not added. In particular, the prefix should not be added if you are
48 -- potentially testing for cross-platforms, since the suffix might not be
49 -- known (its default value comes from the ...-gnatmake prefix).
50 --
51 -- What is Ada_Main???
52 -- What is Language???
53
54 procedure Put
55 (Into_List : in out Name_List_Index;
56 From_List : String_List_Id;
57 In_Tree : Project_Tree_Ref;
58 Lower_Case : Boolean := False);
59 -- Append a name list to a string list
60 -- Describe parameters???
61
62 procedure Duplicate
63 (This : in out Name_List_Index;
64 Shared : Shared_Project_Tree_Data_Access);
65 -- Duplicate a name list
66
67 function Value_Of
68 (Variable : Variable_Value;
69 Default : String) return String;
70 -- Get the value of a single string variable. If Variable is a string list,
71 -- is Nil_Variable_Value,or is defaulted, return Default.
72
73 function Value_Of
74 (Index : Name_Id;
75 In_Array : Array_Element_Id;
76 Shared : Shared_Project_Tree_Data_Access) return Name_Id;
77 -- Get a single string array component. Returns No_Name if there is no
78 -- component Index, if In_Array is null, or if the component is a String
79 -- list. Depending on the attribute (only attributes may be associative
80 -- arrays) the index may or may not be case sensitive. If the index is not
81 -- case sensitive, it is first set to lower case before the search in the
82 -- associative array.
83
84 function Value_Of
85 (Index : Name_Id;
86 Src_Index : Int := 0;
87 In_Array : Array_Element_Id;
88 Shared : Shared_Project_Tree_Data_Access;
89 Force_Lower_Case_Index : Boolean := False;
90 Allow_Wildcards : Boolean := False) return Variable_Value;
91 -- Get a string array component (single String or String list). Returns
92 -- Nil_Variable_Value if no component Index or if In_Array is null.
93 --
94 -- Depending on the attribute (only attributes may be associative arrays)
95 -- the index may or may not be case sensitive. If the index is not case
96 -- sensitive, it is first set to lower case before the search in the
97 -- associative array.
98
99 function Value_Of
100 (Name : Name_Id;
101 Index : Int := 0;
102 Attribute_Or_Array_Name : Name_Id;
103 In_Package : Package_Id;
104 Shared : Shared_Project_Tree_Data_Access;
105 Force_Lower_Case_Index : Boolean := False;
106 Allow_Wildcards : Boolean := False) return Variable_Value;
107 -- In a specific package:
108 -- - if there exists an array Attribute_Or_Array_Name with an index Name,
109 -- returns the corresponding component (depending on the attribute, the
110 -- index may or may not be case sensitive, see previous function),
111 -- - otherwise if there is a single attribute Attribute_Or_Array_Name,
112 -- returns this attribute,
113 -- - otherwise, returns Nil_Variable_Value.
114 -- If In_Package is null, returns Nil_Variable_Value.
115
116 function Value_Of
117 (Index : Name_Id;
118 In_Array : Name_Id;
119 In_Arrays : Array_Id;
120 Shared : Shared_Project_Tree_Data_Access) return Name_Id;
121 -- Get a string array component in an array of an array list. Returns
122 -- No_Name if there is no component Index, if In_Arrays is null, if
123 -- In_Array is not found in In_Arrays or if the component is a String list.
124
125 function Value_Of
126 (Name : Name_Id;
127 In_Arrays : Array_Id;
128 Shared : Shared_Project_Tree_Data_Access) return Array_Element_Id;
129 -- Returns a specified array in an array list. Returns No_Array_Element
130 -- if In_Arrays is null or if Name is not the name of an array in
131 -- In_Arrays. The caller must ensure that Name is in lower case.
132
133 function Value_Of
134 (Name : Name_Id;
135 In_Packages : Package_Id;
136 Shared : Shared_Project_Tree_Data_Access) return Package_Id;
137 -- Returns a specified package in a package list. Returns No_Package
138 -- if In_Packages is null or if Name is not the name of a package in
139 -- Package_List. The caller must ensure that Name is in lower case.
140
141 function Value_Of
142 (Variable_Name : Name_Id;
143 In_Variables : Variable_Id;
144 Shared : Shared_Project_Tree_Data_Access) return Variable_Value;
145 -- Returns a specified variable in a variable list. Returns null if
146 -- In_Variables is null or if Variable_Name is not the name of a
147 -- variable in In_Variables. Caller must ensure that Name is lower case.
148
149 procedure Write_Str
150 (S : String;
151 Max_Length : Positive;
152 Separator : Character);
153 -- Output string S using Output.Write_Str. If S is too long to fit in one
154 -- line of Max_Length, cut it in several lines, using Separator as the last
155 -- character of each line, if possible.
156
157 type Text_File is limited private;
158 -- Represents a text file (default is invalid text file)
159
160 function Is_Valid (File : Text_File) return Boolean;
161 -- Returns True if File designates an open text file that has not yet been
162 -- closed.
163
164 procedure Open (File : out Text_File; Name : String);
165 -- Open a text file to read (File is invalid if text file cannot be opened)
166
167 procedure Create (File : out Text_File; Name : String);
168 -- Create a text file to write (File is invalid if text file cannot be
169 -- created).
170
171 function End_Of_File (File : Text_File) return Boolean;
172 -- Returns True if the end of the text file File has been reached. Fails if
173 -- File is invalid. Return True if File is an out file.
174
175 procedure Get_Line
176 (File : Text_File;
177 Line : out String;
178 Last : out Natural);
179 -- Reads a line from an open text file (fails if File is invalid or in an
180 -- out file).
181
182 procedure Put (File : Text_File; S : String);
183 procedure Put_Line (File : Text_File; Line : String);
184 -- Output a string or a line to an out text file (fails if File is invalid
185 -- or in an in file).
186
187 procedure Close (File : in out Text_File);
188 -- Close an open text file. File becomes invalid. Fails if File is already
189 -- invalid or if an out file cannot be closed successfully.
190
191 -----------------------
192 -- Source info files --
193 -----------------------
194
195 procedure Write_Source_Info_File (Tree : Project_Tree_Ref);
196 -- Create a new source info file, with the path name specified in the
197 -- project tree data. Issue a warning if it is not possible to create
198 -- the new file.
199
200 procedure Read_Source_Info_File (Tree : Project_Tree_Ref);
201 -- Check if there is a source info file specified for the project Tree. If
202 -- so, attempt to read it. If the file exists and is successfully read, set
203 -- the flag Source_Info_File_Exists to True for the tree.
204
205 type Source_Info_Data is record
206 Project : Name_Id;
207 Language : Name_Id;
208 Kind : Source_Kind;
209 Display_Path_Name : Name_Id;
210 Path_Name : Name_Id;
211 Unit_Name : Name_Id := No_Name;
212 Index : Int := 0;
213 Naming_Exception : Naming_Exception_Type := No;
214 end record;
215 -- Data read from a source info file for a single source
216
217 type Source_Info is access all Source_Info_Data;
218 No_Source_Info : constant Source_Info := null;
219
220 type Source_Info_Iterator is private;
221 -- Iterator to get the sources for a single project
222
223 procedure Initialize
224 (Iter : out Source_Info_Iterator;
225 For_Project : Name_Id);
226 -- Initialize Iter for the project
227
228 function Source_Info_Of (Iter : Source_Info_Iterator) return Source_Info;
229 -- Get the source info for the source corresponding to the current value of
230 -- the iterator. Returns No_Source_Info if there is no source corresponding
231 -- to the iterator.
232
233 procedure Next (Iter : in out Source_Info_Iterator);
234 -- Advance the iterator to the next source in the project
235
236 generic
237 with procedure Action (Source : Source_Id);
238 procedure For_Interface_Sources
239 (Tree : Project_Tree_Ref;
240 Project : Project_Id);
241 -- Call Action for every sources that are needed to use Project. This is
242 -- either the sources corresponding to the units in attribute Interfaces
243 -- or all sources of the project. Note that only the bodies that are
244 -- needed (because the unit is generic or contains some inline pragmas)
245 -- are handled. This routine must be called only when the project has
246 -- been built successfully.
247
248 function Relative_Path (Pathname : String; To : String) return String;
249 -- Returns the relative pathname which corresponds to Pathname when
250 -- starting from directory to. Both Pathname and To must be absolute paths.
251
252 private
253 type Text_File_Data is record
254 FD : File_Descriptor := Invalid_FD;
255 Out_File : Boolean := False;
256 Buffer : String (1 .. 1_000);
257 Buffer_Len : Natural := 0;
258 Cursor : Natural := 0;
259 End_Of_File_Reached : Boolean := False;
260 end record;
261
262 type Text_File is access Text_File_Data;
263
264 type Source_Info_Iterator is record
265 Info : Source_Info;
266 Next : Natural;
267 end record;
268
269 end Prj.Util;