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 | --
-- Copyright (C) 2019-2023, AdaCore
--
-- SPDX-License-Identifier: Apache-2.0 WITH LLVM-Exception
--
-- Handle the configuration object for a project tree
limited with GPR2.KB;
with GPR2.Environment;
with GPR2.Log;
with GPR2.Project.Parser;
with GPR2.Project.View;
with GNATCOLL.Refcount;
private with Ada.Containers.Indefinite_Hashed_Maps;
private with Ada.Containers.Vectors;
limited with GPR2.Project.Tree;
package GPR2.Project.Configuration is
Config_File_Key : Integer := 1;
type Object is tagged private;
Undefined : constant Object;
-- This constant is equal to any object declared without an explicit
-- initializer.
function Is_Defined (Self : Object) return Boolean;
-- Returns true if Self is defined
function Has_Messages (Self : Object) return Boolean;
-- Returns whether some messages are present for this configuration
function Has_Error (Self : Object) return Boolean;
-- Returns whether error messages are present for this configuration
function Log_Messages (Self : Object) return Log.Object
with Post => not Self.Has_Messages or else Log_Messages'Result.Count > 0;
-- Returns the Logs, this contains information, warning and error messages
-- found while handling the project.
type Description is private;
-- A configuration description, for a language, a version, specific
-- runtime, etc.
overriding function "=" (Left, Right : Description) return Boolean;
-- Returns True when the Left and Right configuration descriptions are
-- equal.
type Description_Set is array (Positive range <>) of Description;
-- A set of description
Default_Description : constant Description_Set;
function Create
(Language : Language_Id;
Version : Optional_Name_Type := No_Name;
Runtime : Optional_Name_Type := No_Name;
Path : Filename_Optional := No_Filename;
Name : Optional_Name_Type := No_Name) return Description;
-- Returns a description for a configuration. This description object is
-- used to retrieve the available and corresponding compilers. That is,
-- the compilers for the given language, the runtime if specified, etc.
function Language (Descr : Description) return Language_Id;
-- Returns language specified by Descr
function Version (Descr : Description) return Optional_Name_Type;
-- Returns version specified by Descr
function Runtime (Descr : Description) return Optional_Name_Type;
-- Returns runtime specified by Descr
function Path (Descr : Description) return Filename_Optional;
-- Returns path specified by Descr
function Name (Descr : Description) return Optional_Name_Type;
-- Returns name specified by Descr
function Create
(Settings : Description_Set;
Target : Name_Type;
Project : GPR2.Path_Name.Object;
Base : in out GPR2.KB.Object;
Save_Name : GPR2.Path_Name.Object := GPR2.Path_Name.Undefined;
Environment : GPR2.Environment.Object :=
GPR2.Environment.Process_Environment)
return Object
with Pre => Settings'Length > 0;
-- Creates a configuration based on the settings requested.
-- Project parameter is used as source reference for the potential
-- error messages reported.
-- If Save_Name is defined, the configuration project is saved there.
function Load
(Filename : Path_Name.Object) return Object;
-- Creates a configuration object for the given configuration file
function Corresponding_View (Self : Object) return Project.View.Object
with Pre => Self.Is_Defined,
Post => Corresponding_View'Result.Is_Defined;
-- Gets project for the given configuration object
function Runtime
(Self : Object; Language : Language_Id) return Optional_Name_Type
with Pre => Self.Is_Defined;
-- Returns the runtime specified for Language or the empty string if no
-- specific runtime has been specified for this language.
function Archive_Suffix (Self : Object) return Filename_Type
with Inline,
Pre => Self.Is_Defined,
Post => Archive_Suffix'Result (Archive_Suffix'Result'First) = '.';
-- Returns the archive file suffix (with the leading dot)
function Object_File_Suffix
(Self : Object;
Language : Language_Id) return Filename_Type
with Inline,
Pre => Self.Is_Defined,
Post => Object_File_Suffix'Result
(Object_File_Suffix'Result'First) = '.';
-- Returns the object file suffix (with the leading dot)
function Dependency_File_Suffix
(Self : Object;
Language : Language_Id) return Filename_Type
with Pre => Self.Is_Defined,
Post => Dependency_File_Suffix'Result
(Dependency_File_Suffix'Result'First) = '.';
-- Returns the dependency file suffix (with the leading dot)
function Has_Externals (Self : Object) return Boolean
with Pre => Self.Is_Defined;
-- Returns whether Externals where found during configuration project load
function Externals (Self : Object) return Containers.Name_Set
with Pre => Self.Is_Defined and then Self.Has_Externals,
Post => not Externals'Result.Is_Empty;
-- Returns externals found in parsed configuration project
private
type Description is record
Language : Language_Id;
Version : Unbounded_String;
Runtime : Unbounded_String;
Path : Unbounded_String;
Name : Unbounded_String;
end record;
function Language (Descr : Description) return Language_Id is
(Descr.Language);
function Version (Descr : Description) return Optional_Name_Type is
(Optional_Name_Type (To_String (Descr.Version)));
function Runtime (Descr : Description) return Optional_Name_Type is
(Optional_Name_Type (To_String (Descr.Runtime)));
function Path (Descr : Description) return Filename_Optional is
(Filename_Optional (To_String (Descr.Path)));
function Name (Descr : Description) return Optional_Name_Type is
(Optional_Name_Type (To_String (Descr.Name)));
overriding function "=" (Left, Right : Description) return Boolean
is
(Language (Left) = Language (Right)
and then Version (Left) = Version (Right)
and then Runtime (Left) = Runtime (Right)
and then Path (Left) = Path (Right)
and then Name (Left) = Name (Right));
package Descriptions is new Ada.Containers.Vectors (Positive, Description);
package Language_Dict is new Ada.Containers.Indefinite_Hashed_Maps
(Language_Id, String, GPR2.Hash, GPR2."=");
type Config_Cache_Object;
type Config_Cache_Access is access all Config_Cache_Object;
type Config_Cache_Object is record
Archive_Suffix : Unbounded_String;
Object_File_Suffix : Language_Dict.Map;
end record;
package Cache_Refcount is new GNATCOLL.Refcount.Shared_Pointers
(Element_Type => Config_Cache_Object);
type Object is tagged record
Messages : Log.Object;
Project : GPR2.Project.Parser.Object;
Conf : GPR2.Project.View.Object;
Descriptions : Configuration.Descriptions.Vector;
-- Cache
Cache : Cache_Refcount.Ref;
end record;
procedure Bind_To_Tree
(Self : in out Object;
Tree : not null access Project.Tree.Object);
-- Bind configuration to Tree
Undefined : constant Object := (others => <>);
function Is_Defined (Self : Object) return Boolean is
(Self /= Undefined);
function Has_Error (Self : Object) return Boolean is
(Self.Messages.Has_Error);
Default_Description : constant Description_Set (1 .. 1) :=
(1 => (Language => Ada_Language,
others => <>));
end GPR2.Project.Configuration;
|