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