]>
Commit | Line | Data |
---|---|---|
19235870 RK |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT COMPILER COMPONENTS -- | |
4 | -- -- | |
5 | -- P R J . P A R T -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
af6478c8 | 9 | -- Copyright (C) 2001-2014, Free Software Foundation, Inc. -- |
19235870 RK |
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- -- | |
b5c84c3c | 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- |
19235870 RK |
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 -- | |
b5c84c3c RD |
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. -- | |
19235870 RK |
20 | -- -- |
21 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
71ff80dc | 22 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
19235870 RK |
23 | -- -- |
24 | ------------------------------------------------------------------------------ | |
25 | ||
ee2ba856 | 26 | with Atree; use Atree; |
fbf5a39b | 27 | with Err_Vars; use Err_Vars; |
b7e429ab | 28 | with Opt; use Opt; |
fbf5a39b AC |
29 | with Osint; use Osint; |
30 | with Output; use Output; | |
31 | with Prj.Com; use Prj.Com; | |
32 | with Prj.Dect; | |
a0a786e3 | 33 | with Prj.Env; use Prj.Env; |
fbf5a39b | 34 | with Prj.Err; use Prj.Err; |
fbf5a39b AC |
35 | with Sinput; use Sinput; |
36 | with Sinput.P; use Sinput.P; | |
9596236a | 37 | with Snames; |
fbf5a39b | 38 | with Table; |
fbf5a39b | 39 | |
f6da8aff RD |
40 | with Ada.Characters.Handling; use Ada.Characters.Handling; |
41 | with Ada.Exceptions; use Ada.Exceptions; | |
fbf5a39b | 42 | |
55c1c66d | 43 | with GNAT.HTable; use GNAT.HTable; |
9596236a | 44 | |
19235870 RK |
45 | package body Prj.Part is |
46 | ||
7e98a4c6 VC |
47 | Buffer : String_Access; |
48 | Buffer_Last : Natural := 0; | |
49 | ||
6c1f47ee | 50 | Dir_Sep : Character renames GNAT.OS_Lib.Directory_Separator; |
9596236a | 51 | |
19235870 RK |
52 | ------------------------------------ |
53 | -- Local Packages and Subprograms -- | |
54 | ------------------------------------ | |
55 | ||
fbf5a39b AC |
56 | type With_Id is new Nat; |
57 | No_With : constant With_Id := 0; | |
58 | ||
59 | type With_Record is record | |
ede007da | 60 | Path : Path_Name_Type; |
fbf5a39b AC |
61 | Location : Source_Ptr; |
62 | Limited_With : Boolean; | |
c45b6ae0 | 63 | Node : Project_Node_Id; |
fbf5a39b AC |
64 | Next : With_Id; |
65 | end record; | |
66 | -- Information about an imported project, to be put in table Withs below | |
67 | ||
68 | package Withs is new Table.Table | |
69 | (Table_Component_Type => With_Record, | |
70 | Table_Index_Type => With_Id, | |
71 | Table_Low_Bound => 1, | |
72 | Table_Initial => 10, | |
ddd6e5ae | 73 | Table_Increment => 100, |
fbf5a39b AC |
74 | Table_Name => "Prj.Part.Withs"); |
75 | -- Table used to store temporarily paths and locations of imported | |
1a5d715a VC |
76 | -- projects. These imported projects will be effectively parsed later: just |
77 | -- before parsing the current project for the non limited withed projects, | |
78 | -- after getting its name; after complete parsing of the current project | |
79 | -- for the limited withed projects. | |
fbf5a39b | 80 | |
6871ba5f | 81 | type Names_And_Id is record |
39f4e199 VC |
82 | Path_Name : Path_Name_Type; |
83 | Canonical_Path_Name : Path_Name_Type; | |
8a7988f5 | 84 | Id : Project_Node_Id; |
1a5d715a | 85 | Limited_With : Boolean; |
fbf5a39b AC |
86 | end record; |
87 | ||
19235870 | 88 | package Project_Stack is new Table.Table |
6871ba5f | 89 | (Table_Component_Type => Names_And_Id, |
19235870 RK |
90 | Table_Index_Type => Nat, |
91 | Table_Low_Bound => 1, | |
92 | Table_Initial => 10, | |
ddd6e5ae | 93 | Table_Increment => 100, |
19235870 RK |
94 | Table_Name => "Prj.Part.Project_Stack"); |
95 | -- This table is used to detect circular dependencies | |
fbf5a39b AC |
96 | -- for imported and extended projects and to get the project ids of |
97 | -- limited imported projects when there is a circularity with at least | |
98 | -- one limited imported project file. | |
99 | ||
55c1c66d | 100 | package Virtual_Hash is new GNAT.HTable.Simple_HTable |
9596236a AC |
101 | (Header_Num => Header_Num, |
102 | Element => Project_Node_Id, | |
ef992452 | 103 | No_Element => Project_Node_High_Bound, |
9596236a AC |
104 | Key => Project_Node_Id, |
105 | Hash => Prj.Tree.Hash, | |
106 | Equal => "="); | |
ef992452 AC |
107 | -- Hash table to store the node ids of projects for which a virtual |
108 | -- extending project need to be created. The corresponding value is the | |
109 | -- head of a list of WITH clauses corresponding to the context of the | |
110 | -- enclosing EXTEND ALL projects. Note: Default_Element is Project_Node_ | |
111 | -- High_Bound because we want Empty_Node to be a possible value. | |
9596236a | 112 | |
55c1c66d | 113 | package Processed_Hash is new GNAT.HTable.Simple_HTable |
9596236a AC |
114 | (Header_Num => Header_Num, |
115 | Element => Boolean, | |
116 | No_Element => False, | |
117 | Key => Project_Node_Id, | |
118 | Hash => Prj.Tree.Hash, | |
119 | Equal => "="); | |
120 | -- Hash table to store the project process when looking for project that | |
121 | -- need to have a virtual extending project, to avoid processing the same | |
122 | -- project twice. | |
123 | ||
9d9f5f49 AC |
124 | function Has_Circular_Dependencies |
125 | (Flags : Processing_Flags; | |
126 | Normed_Path_Name : Path_Name_Type; | |
127 | Canonical_Path_Name : Path_Name_Type) return Boolean; | |
128 | -- Check for a circular dependency in the loaded project. | |
129 | -- Generates an error message in such a case. | |
130 | ||
131 | procedure Read_Project_Qualifier | |
132 | (Flags : Processing_Flags; | |
133 | In_Tree : Project_Node_Tree_Ref; | |
134 | Is_Config_File : Boolean; | |
135 | Qualifier_Location : out Source_Ptr; | |
136 | Project : Project_Node_Id); | |
137 | -- Check if there is a qualifier before the reserved word "project" | |
138 | ||
6c1f47ee EB |
139 | -- Hash table to cache project path to avoid looking for them on the path |
140 | ||
9d9f5f49 AC |
141 | procedure Check_Extending_All_Imports |
142 | (Flags : Processing_Flags; | |
143 | In_Tree : Project_Node_Tree_Ref; | |
144 | Project : Project_Node_Id); | |
145 | -- Check that a non extending-all project does not import an | |
146 | -- extending-all project. | |
147 | ||
148 | procedure Check_Aggregate_Imports | |
149 | (Flags : Processing_Flags; | |
150 | In_Tree : Project_Node_Tree_Ref; | |
151 | Project : Project_Node_Id); | |
152 | -- Check that an aggregate project only imports abstract projects | |
153 | ||
88de755d VC |
154 | procedure Check_Import_Aggregate |
155 | (Flags : Processing_Flags; | |
156 | In_Tree : Project_Node_Tree_Ref; | |
157 | Project : Project_Node_Id); | |
a4ab03b0 | 158 | -- Check that a non aggregate project does not import an aggregate project |
88de755d | 159 | |
9596236a | 160 | procedure Create_Virtual_Extending_Project |
ef992452 AC |
161 | (For_Project : Project_Node_Id; |
162 | Main_Project : Project_Node_Id; | |
163 | Extension_Withs : Project_Node_Id; | |
164 | In_Tree : Project_Node_Tree_Ref); | |
9596236a | 165 | -- Create a virtual extending project of For_Project. Main_Project is |
ef992452 AC |
166 | -- the extending all project. Extension_Withs is the head of a WITH clause |
167 | -- list to be added to the created virtual project. | |
9cd6ae61 VC |
168 | -- |
169 | -- The String_Value_Of is not set for the automatically added with | |
170 | -- clause and keeps the default value of No_Name. This enables Prj.PP | |
171 | -- to skip these automatically added with clauses to be processed. | |
9596236a AC |
172 | |
173 | procedure Look_For_Virtual_Projects_For | |
174 | (Proj : Project_Node_Id; | |
7e98a4c6 | 175 | In_Tree : Project_Node_Tree_Ref; |
9596236a AC |
176 | Potentially_Virtual : Boolean); |
177 | -- Look for projects that need to have a virtual extending project. | |
178 | -- This procedure is recursive. If called with Potentially_Virtual set to | |
179 | -- True, then Proj may need an virtual extending project; otherwise it | |
180 | -- does not (because it is already extended), but other projects that it | |
181 | -- imports may need to be virtually extended. | |
182 | ||
ca311c9f VC |
183 | type Extension_Origin is (None, Extending_Simple, Extending_All); |
184 | -- Type of parameter From_Extended for procedures Parse_Single_Project and | |
185 | -- Post_Parse_Context_Clause. Extending_All means that we are parsing the | |
186 | -- tree rooted at an extending all project. | |
187 | ||
188 | procedure Parse_Single_Project | |
189 | (In_Tree : Project_Node_Tree_Ref; | |
190 | Project : out Project_Node_Id; | |
191 | Extends_All : out Boolean; | |
a0a786e3 | 192 | Path_Name_Id : Path_Name_Type; |
ca311c9f VC |
193 | Extended : Boolean; |
194 | From_Extended : Extension_Origin; | |
195 | In_Limited : Boolean; | |
196 | Packages_To_Check : String_List_Access; | |
197 | Depth : Natural; | |
bd0a4cab | 198 | Current_Dir : String; |
e2d9085b | 199 | Is_Config_File : Boolean; |
9d5598bf AC |
200 | Env : in out Environment; |
201 | Implicit_Project : Boolean := False); | |
be658959 AC |
202 | -- Parse a project file. This is a recursive procedure: it calls itself for |
203 | -- imported and extended projects. When From_Extended is not None, if the | |
204 | -- project has already been parsed and is an extended project A, return the | |
205 | -- ultimate (not extended) project that extends A. When In_Limited is True, | |
206 | -- the importing path includes at least one "limited with". When parsing | |
207 | -- configuration projects, do not allow a depth > 1. | |
bd0a4cab EB |
208 | -- |
209 | -- Is_Config_File should be set to True if the project represents a config | |
210 | -- file (.cgpr) since some specific checks apply. | |
9d5598bf AC |
211 | -- |
212 | -- If Implicit_Project is True, change the Directory of the project node | |
213 | -- to be the Current_Dir. Recursive calls to Parse_Single_Project are | |
214 | -- always done with the default False value for Implicit_Project. | |
ca311c9f | 215 | |
7e98a4c6 VC |
216 | procedure Pre_Parse_Context_Clause |
217 | (In_Tree : Project_Node_Tree_Ref; | |
bd0a4cab | 218 | Context_Clause : out With_Id; |
e2d9085b EB |
219 | Is_Config_File : Boolean; |
220 | Flags : Processing_Flags); | |
1a5d715a VC |
221 | -- Parse the context clause of a project. Store the paths and locations of |
222 | -- the imported projects in table Withs. Does nothing if there is no | |
223 | -- context clause (if the current token is not "with" or "limited" followed | |
224 | -- by "with"). | |
bd0a4cab EB |
225 | -- Is_Config_File should be set to True if the project represents a config |
226 | -- file (.cgpr) since some specific checks apply. | |
fbf5a39b AC |
227 | |
228 | procedure Post_Parse_Context_Clause | |
229 | (Context_Clause : With_Id; | |
7e98a4c6 | 230 | In_Tree : Project_Node_Tree_Ref; |
07ef182e | 231 | In_Limited : Boolean; |
1a5d715a VC |
232 | Limited_Withs : Boolean; |
233 | Imported_Projects : in out Project_Node_Id; | |
39f4e199 | 234 | Project_Directory : Path_Name_Type; |
0da2c8ac | 235 | From_Extended : Extension_Origin; |
ede007da | 236 | Packages_To_Check : String_List_Access; |
6c1f47ee | 237 | Depth : Natural; |
bd0a4cab | 238 | Current_Dir : String; |
e2d9085b | 239 | Is_Config_File : Boolean; |
4437a530 | 240 | Env : in out Environment); |
1a5d715a VC |
241 | -- Parse the imported projects that have been stored in table Withs, if |
242 | -- any. From_Extended is used for the call to Parse_Single_Project below. | |
9a6dc470 | 243 | -- |
1a5d715a VC |
244 | -- When In_Limited is True, the importing path includes at least one |
245 | -- "limited with". When Limited_Withs is False, only non limited withed | |
246 | -- projects are parsed. When Limited_Withs is True, only limited withed | |
247 | -- projects are parsed. | |
9a6dc470 | 248 | -- |
bd0a4cab EB |
249 | -- Is_Config_File should be set to True if the project represents a config |
250 | -- file (.cgpr) since some specific checks apply. | |
19235870 | 251 | |
bd0a4cab EB |
252 | function Project_Name_From |
253 | (Path_Name : String; | |
254 | Is_Config_File : Boolean) return Name_Id; | |
19235870 RK |
255 | -- Returns the name of the project that corresponds to its path name. |
256 | -- Returns No_Name if the path name is invalid, because the corresponding | |
257 | -- project name does not have the syntax of an ada identifier. | |
258 | ||
ef992452 AC |
259 | function Copy_With_Clause |
260 | (With_Clause : Project_Node_Id; | |
261 | In_Tree : Project_Node_Tree_Ref; | |
262 | Next_Clause : Project_Node_Id) return Project_Node_Id; | |
263 | -- Return a copy of With_Clause in In_Tree, whose Next_With_Clause is the | |
264 | -- indicated one. | |
265 | ||
266 | ---------------------- | |
267 | -- Copy_With_Clause -- | |
268 | ---------------------- | |
269 | ||
270 | function Copy_With_Clause | |
271 | (With_Clause : Project_Node_Id; | |
272 | In_Tree : Project_Node_Tree_Ref; | |
273 | Next_Clause : Project_Node_Id) return Project_Node_Id | |
274 | is | |
275 | New_With_Clause : constant Project_Node_Id := | |
276 | Default_Project_Node (In_Tree, N_With_Clause); | |
277 | begin | |
278 | Set_Name_Of (New_With_Clause, In_Tree, | |
279 | Name_Of (With_Clause, In_Tree)); | |
280 | Set_Path_Name_Of (New_With_Clause, In_Tree, | |
281 | Path_Name_Of (With_Clause, In_Tree)); | |
282 | Set_Project_Node_Of (New_With_Clause, In_Tree, | |
283 | Project_Node_Of (With_Clause, In_Tree)); | |
284 | Set_Next_With_Clause_Of (New_With_Clause, In_Tree, Next_Clause); | |
285 | ||
286 | return New_With_Clause; | |
287 | end Copy_With_Clause; | |
288 | ||
9596236a AC |
289 | -------------------------------------- |
290 | -- Create_Virtual_Extending_Project -- | |
291 | -------------------------------------- | |
292 | ||
293 | procedure Create_Virtual_Extending_Project | |
ef992452 AC |
294 | (For_Project : Project_Node_Id; |
295 | Main_Project : Project_Node_Id; | |
296 | Extension_Withs : Project_Node_Id; | |
297 | In_Tree : Project_Node_Tree_Ref) | |
9596236a AC |
298 | is |
299 | ||
300 | Virtual_Name : constant String := | |
301 | Virtual_Prefix & | |
7e98a4c6 | 302 | Get_Name_String (Name_Of (For_Project, In_Tree)); |
9596236a AC |
303 | -- The name of the virtual extending project |
304 | ||
305 | Virtual_Name_Id : Name_Id; | |
306 | -- Virtual extending project name id | |
307 | ||
39f4e199 | 308 | Virtual_Path_Id : Path_Name_Type; |
9596236a AC |
309 | -- Fake path name of the virtual extending project. The directory is |
310 | -- the same directory as the extending all project. | |
311 | ||
9596236a AC |
312 | -- The source of the virtual extending project is something like: |
313 | ||
314 | -- project V$<project name> extends <project path> is | |
315 | ||
316 | -- for Source_Dirs use (); | |
317 | ||
318 | -- end V$<project name>; | |
319 | ||
320 | -- The project directory cannot be specified during parsing; it will be | |
321 | -- put directly in the virtual extending project data during processing. | |
322 | ||
323 | -- Nodes that made up the virtual extending project | |
324 | ||
fc2c32e2 | 325 | Virtual_Project : Project_Node_Id; |
9596236a | 326 | With_Clause : constant Project_Node_Id := |
7e98a4c6 VC |
327 | Default_Project_Node |
328 | (In_Tree, N_With_Clause); | |
fc2c32e2 | 329 | Project_Declaration : Project_Node_Id; |
9596236a | 330 | Source_Dirs_Declaration : constant Project_Node_Id := |
7e98a4c6 VC |
331 | Default_Project_Node |
332 | (In_Tree, N_Declarative_Item); | |
9596236a AC |
333 | Source_Dirs_Attribute : constant Project_Node_Id := |
334 | Default_Project_Node | |
7e98a4c6 | 335 | (In_Tree, N_Attribute_Declaration, List); |
9596236a | 336 | Source_Dirs_Expression : constant Project_Node_Id := |
7e98a4c6 VC |
337 | Default_Project_Node |
338 | (In_Tree, N_Expression, List); | |
9596236a | 339 | Source_Dirs_Term : constant Project_Node_Id := |
7e98a4c6 VC |
340 | Default_Project_Node |
341 | (In_Tree, N_Term, List); | |
9596236a AC |
342 | Source_Dirs_List : constant Project_Node_Id := |
343 | Default_Project_Node | |
7e98a4c6 | 344 | (In_Tree, N_Literal_String_List, List); |
9596236a AC |
345 | |
346 | begin | |
9596236a AC |
347 | -- Get the virtual path name |
348 | ||
7e98a4c6 | 349 | Get_Name_String (Path_Name_Of (Main_Project, In_Tree)); |
9596236a AC |
350 | |
351 | while Name_Len > 0 | |
43c58950 | 352 | and then not Is_Directory_Separator (Name_Buffer (Name_Len)) |
9596236a AC |
353 | loop |
354 | Name_Len := Name_Len - 1; | |
355 | end loop; | |
356 | ||
357 | Name_Buffer (Name_Len + 1 .. Name_Len + Virtual_Name'Length) := | |
358 | Virtual_Name; | |
359 | Name_Len := Name_Len + Virtual_Name'Length; | |
360 | Virtual_Path_Id := Name_Find; | |
361 | ||
fc2c32e2 EB |
362 | -- Get the virtual name id |
363 | ||
364 | Name_Len := Virtual_Name'Length; | |
365 | Name_Buffer (1 .. Name_Len) := Virtual_Name; | |
366 | Virtual_Name_Id := Name_Find; | |
367 | ||
368 | Virtual_Project := Create_Project | |
369 | (In_Tree => In_Tree, | |
370 | Name => Virtual_Name_Id, | |
371 | Full_Path => Virtual_Path_Id, | |
372 | Is_Config_File => False); | |
373 | ||
374 | Project_Declaration := Project_Declaration_Of (Virtual_Project, In_Tree); | |
375 | ||
ef992452 AC |
376 | -- Add a WITH clause to the main project to import the newly created |
377 | -- virtual extending project. | |
9596236a | 378 | |
7e98a4c6 VC |
379 | Set_Name_Of (With_Clause, In_Tree, Virtual_Name_Id); |
380 | Set_Path_Name_Of (With_Clause, In_Tree, Virtual_Path_Id); | |
381 | Set_Project_Node_Of (With_Clause, In_Tree, Virtual_Project); | |
9596236a | 382 | Set_Next_With_Clause_Of |
7e98a4c6 VC |
383 | (With_Clause, In_Tree, First_With_Clause_Of (Main_Project, In_Tree)); |
384 | Set_First_With_Clause_Of (Main_Project, In_Tree, With_Clause); | |
9596236a | 385 | |
ef992452 AC |
386 | -- Copy with clauses for projects imported by the extending-all project |
387 | ||
388 | declare | |
389 | Org_With_Clause : Project_Node_Id := Extension_Withs; | |
390 | New_With_Clause : Project_Node_Id := Empty_Node; | |
cc96a1b8 | 391 | |
ef992452 AC |
392 | begin |
393 | while Present (Org_With_Clause) loop | |
394 | New_With_Clause := | |
395 | Copy_With_Clause (Org_With_Clause, In_Tree, New_With_Clause); | |
396 | ||
397 | Org_With_Clause := Next_With_Clause_Of (Org_With_Clause, In_Tree); | |
398 | end loop; | |
cc96a1b8 | 399 | |
ef992452 AC |
400 | Set_First_With_Clause_Of (Virtual_Project, In_Tree, New_With_Clause); |
401 | end; | |
402 | ||
9596236a AC |
403 | -- Virtual project node |
404 | ||
7e98a4c6 VC |
405 | Set_Location_Of |
406 | (Virtual_Project, In_Tree, Location_Of (Main_Project, In_Tree)); | |
9596236a | 407 | Set_Extended_Project_Path_Of |
7e98a4c6 | 408 | (Virtual_Project, In_Tree, Path_Name_Of (For_Project, In_Tree)); |
9596236a AC |
409 | |
410 | -- Project declaration | |
411 | ||
412 | Set_First_Declarative_Item_Of | |
7e98a4c6 VC |
413 | (Project_Declaration, In_Tree, Source_Dirs_Declaration); |
414 | Set_Extended_Project_Of (Project_Declaration, In_Tree, For_Project); | |
9596236a AC |
415 | |
416 | -- Source_Dirs declaration | |
417 | ||
7e98a4c6 VC |
418 | Set_Current_Item_Node |
419 | (Source_Dirs_Declaration, In_Tree, Source_Dirs_Attribute); | |
9596236a AC |
420 | |
421 | -- Source_Dirs attribute | |
422 | ||
7e98a4c6 VC |
423 | Set_Name_Of (Source_Dirs_Attribute, In_Tree, Snames.Name_Source_Dirs); |
424 | Set_Expression_Of | |
425 | (Source_Dirs_Attribute, In_Tree, Source_Dirs_Expression); | |
9596236a AC |
426 | |
427 | -- Source_Dirs expression | |
428 | ||
7e98a4c6 | 429 | Set_First_Term (Source_Dirs_Expression, In_Tree, Source_Dirs_Term); |
9596236a AC |
430 | |
431 | -- Source_Dirs term | |
432 | ||
7e98a4c6 | 433 | Set_Current_Term (Source_Dirs_Term, In_Tree, Source_Dirs_List); |
9596236a AC |
434 | |
435 | -- Source_Dirs empty list: nothing to do | |
9596236a AC |
436 | end Create_Virtual_Extending_Project; |
437 | ||
9596236a AC |
438 | ----------------------------------- |
439 | -- Look_For_Virtual_Projects_For -- | |
440 | ----------------------------------- | |
441 | ||
ef992452 AC |
442 | Extension_Withs : Project_Node_Id; |
443 | -- Head of the current EXTENDS ALL imports list. When creating virtual | |
444 | -- projects for an EXTENDS ALL, we import in each virtual project all | |
445 | -- of the projects that appear in WITH clauses of the extending projects. | |
446 | -- This ensures that virtual projects share a consistent environment (in | |
447 | -- particular if a project imported by one of the extending projects | |
448 | -- replaces some runtime units). | |
449 | ||
9596236a AC |
450 | procedure Look_For_Virtual_Projects_For |
451 | (Proj : Project_Node_Id; | |
7e98a4c6 | 452 | In_Tree : Project_Node_Tree_Ref; |
9596236a | 453 | Potentially_Virtual : Boolean) |
9596236a AC |
454 | is |
455 | Declaration : Project_Node_Id := Empty_Node; | |
456 | -- Node for the project declaration of Proj | |
457 | ||
458 | With_Clause : Project_Node_Id := Empty_Node; | |
459 | -- Node for a with clause of Proj | |
460 | ||
cc96a1b8 | 461 | Imported : Project_Node_Id := Empty_Node; |
9596236a AC |
462 | -- Node for a project imported by Proj |
463 | ||
cc96a1b8 | 464 | Extended : Project_Node_Id := Empty_Node; |
9596236a AC |
465 | -- Node for the eventual project extended by Proj |
466 | ||
ef992452 AC |
467 | Extends_All : Boolean := False; |
468 | -- Set True if Proj is an EXTENDS ALL project | |
469 | ||
470 | Saved_Extension_Withs : constant Project_Node_Id := Extension_Withs; | |
471 | ||
9596236a | 472 | begin |
ef992452 | 473 | -- Nothing to do if Proj is undefined or has already been processed |
9596236a | 474 | |
4f469be3 | 475 | if Present (Proj) and then not Processed_Hash.Get (Proj) then |
cc96a1b8 | 476 | |
9596236a AC |
477 | -- Make sure the project will not be processed again |
478 | ||
479 | Processed_Hash.Set (Proj, True); | |
480 | ||
7e98a4c6 | 481 | Declaration := Project_Declaration_Of (Proj, In_Tree); |
9596236a | 482 | |
4f469be3 | 483 | if Present (Declaration) then |
7e98a4c6 | 484 | Extended := Extended_Project_Of (Declaration, In_Tree); |
ef992452 | 485 | Extends_All := Is_Extending_All (Proj, In_Tree); |
9596236a AC |
486 | end if; |
487 | ||
488 | -- If this is a project that may need a virtual extending project | |
489 | -- and it is not itself an extending project, put it in the list. | |
490 | ||
4f469be3 | 491 | if Potentially_Virtual and then No (Extended) then |
ef992452 | 492 | Virtual_Hash.Set (Proj, Extension_Withs); |
9596236a AC |
493 | end if; |
494 | ||
495 | -- Now check the projects it imports | |
496 | ||
7e98a4c6 | 497 | With_Clause := First_With_Clause_Of (Proj, In_Tree); |
4f469be3 | 498 | while Present (With_Clause) loop |
7e98a4c6 | 499 | Imported := Project_Node_Of (With_Clause, In_Tree); |
9596236a | 500 | |
4f469be3 | 501 | if Present (Imported) then |
9596236a | 502 | Look_For_Virtual_Projects_For |
7e98a4c6 | 503 | (Imported, In_Tree, Potentially_Virtual => True); |
9596236a AC |
504 | end if; |
505 | ||
ef992452 | 506 | if Extends_All then |
cc96a1b8 | 507 | |
ef992452 AC |
508 | -- This is an EXTENDS ALL project: prepend each of its WITH |
509 | -- clauses to the currently active list of extension deps. | |
510 | ||
511 | Extension_Withs := | |
512 | Copy_With_Clause (With_Clause, In_Tree, Extension_Withs); | |
513 | end if; | |
514 | ||
7e98a4c6 | 515 | With_Clause := Next_With_Clause_Of (With_Clause, In_Tree); |
9596236a AC |
516 | end loop; |
517 | ||
518 | -- Check also the eventual project extended by Proj. As this project | |
519 | -- is already extended, call recursively with Potentially_Virtual | |
520 | -- being False. | |
521 | ||
522 | Look_For_Virtual_Projects_For | |
7e98a4c6 | 523 | (Extended, In_Tree, Potentially_Virtual => False); |
ef992452 AC |
524 | |
525 | Extension_Withs := Saved_Extension_Withs; | |
9596236a AC |
526 | end if; |
527 | end Look_For_Virtual_Projects_For; | |
528 | ||
19235870 RK |
529 | ----------- |
530 | -- Parse -- | |
531 | ----------- | |
532 | ||
533 | procedure Parse | |
e917aec2 RD |
534 | (In_Tree : Project_Node_Tree_Ref; |
535 | Project : out Project_Node_Id; | |
536 | Project_File_Name : String; | |
537 | Errout_Handling : Errout_Mode := Always_Finalize; | |
4b8b7784 | 538 | Packages_To_Check : String_List_Access; |
e917aec2 RD |
539 | Store_Comments : Boolean := False; |
540 | Current_Directory : String := ""; | |
541 | Is_Config_File : Boolean; | |
542 | Env : in out Prj.Tree.Environment; | |
9d5598bf AC |
543 | Target_Name : String := ""; |
544 | Implicit_Project : Boolean := False) | |
19235870 | 545 | is |
b7e429ab | 546 | Dummy : Boolean; |
1b685674 | 547 | pragma Warnings (Off, Dummy); |
19235870 | 548 | |
ddd6e5ae VC |
549 | Real_Project_File_Name : String_Access := |
550 | Osint.To_Canonical_File_Spec | |
551 | (Project_File_Name); | |
a0a786e3 | 552 | Path_Name_Id : Path_Name_Type; |
ddd6e5ae | 553 | |
19235870 | 554 | begin |
0180fd26 | 555 | In_Tree.Incomplete_With := False; |
527f5eb6 AC |
556 | Project_Stack.Init; |
557 | Tree_Private_Part.Projects_Htable.Reset (In_Tree.Projects_HT); | |
0180fd26 | 558 | |
4437a530 | 559 | if not Is_Initialized (Env.Project_Path) then |
a96ca600 | 560 | Prj.Env.Initialize_Default_Project_Path |
4437a530 | 561 | (Env.Project_Path, Target_Name); |
a96ca600 EB |
562 | end if; |
563 | ||
ddd6e5ae VC |
564 | if Real_Project_File_Name = null then |
565 | Real_Project_File_Name := new String'(Project_File_Name); | |
566 | end if; | |
567 | ||
19235870 RK |
568 | Project := Empty_Node; |
569 | ||
4437a530 | 570 | Find_Project (Env.Project_Path, |
a0a786e3 EB |
571 | Project_File_Name => Real_Project_File_Name.all, |
572 | Directory => Current_Directory, | |
a96ca600 | 573 | Path => Path_Name_Id); |
a0a786e3 | 574 | Free (Real_Project_File_Name); |
19235870 | 575 | |
c0e538ad AC |
576 | if Errout_Handling /= Never_Finalize then |
577 | Prj.Err.Initialize; | |
578 | end if; | |
579 | ||
a0a786e3 EB |
580 | Prj.Err.Scanner.Set_Comment_As_Token (Store_Comments); |
581 | Prj.Err.Scanner.Set_End_Of_Line_As_Token (Store_Comments); | |
ddd6e5ae | 582 | |
a0a786e3 EB |
583 | if Path_Name_Id = No_Path then |
584 | declare | |
585 | P : String_Access; | |
586 | begin | |
4437a530 | 587 | Get_Path (Env.Project_Path, Path => P); |
1982d5a8 | 588 | |
fbf5a39b | 589 | Prj.Com.Fail |
3dd9959c AC |
590 | ("project file """ |
591 | & Project_File_Name | |
592 | & """ not found in " | |
a0a786e3 | 593 | & P.all); |
fbf5a39b AC |
594 | Project := Empty_Node; |
595 | return; | |
a0a786e3 EB |
596 | end; |
597 | end if; | |
19235870 | 598 | |
a0a786e3 | 599 | -- Parse the main project file |
0c0c6f49 | 600 | |
a0a786e3 EB |
601 | begin |
602 | Parse_Single_Project | |
603 | (In_Tree => In_Tree, | |
604 | Project => Project, | |
605 | Extends_All => Dummy, | |
606 | Path_Name_Id => Path_Name_Id, | |
607 | Extended => False, | |
608 | From_Extended => None, | |
609 | In_Limited => False, | |
610 | Packages_To_Check => Packages_To_Check, | |
611 | Depth => 0, | |
612 | Current_Dir => Current_Directory, | |
613 | Is_Config_File => Is_Config_File, | |
9d5598bf AC |
614 | Env => Env, |
615 | Implicit_Project => Implicit_Project); | |
9596236a | 616 | |
a0a786e3 EB |
617 | exception |
618 | when Types.Unrecoverable_Error => | |
3ce5ca75 | 619 | |
a0a786e3 EB |
620 | -- Unrecoverable_Error is raised when a line is too long. |
621 | -- A meaningful error message will be displayed later. | |
3ce5ca75 | 622 | |
a0a786e3 EB |
623 | Project := Empty_Node; |
624 | end; | |
9596236a | 625 | |
a0a786e3 EB |
626 | -- If Project is an extending-all project, create the eventual |
627 | -- virtual extending projects and check that there are no illegally | |
628 | -- imported projects. | |
9596236a | 629 | |
a0a786e3 EB |
630 | if Present (Project) |
631 | and then Is_Extending_All (Project, In_Tree) | |
632 | then | |
633 | -- First look for projects that potentially need a virtual | |
634 | -- extending project. | |
9596236a | 635 | |
a0a786e3 EB |
636 | Virtual_Hash.Reset; |
637 | Processed_Hash.Reset; | |
9596236a | 638 | |
a0a786e3 EB |
639 | -- Mark the extending all project as processed, to avoid checking |
640 | -- the imported projects in case of a "limited with" on this | |
641 | -- extending all project. | |
9596236a | 642 | |
a0a786e3 | 643 | Processed_Hash.Set (Project, True); |
9596236a | 644 | |
a0a786e3 EB |
645 | declare |
646 | Declaration : constant Project_Node_Id := | |
3ce5ca75 | 647 | Project_Declaration_Of (Project, In_Tree); |
a0a786e3 | 648 | begin |
ef992452 | 649 | Extension_Withs := First_With_Clause_Of (Project, In_Tree); |
a0a786e3 EB |
650 | Look_For_Virtual_Projects_For |
651 | (Extended_Project_Of (Declaration, In_Tree), In_Tree, | |
652 | Potentially_Virtual => False); | |
653 | end; | |
9596236a | 654 | |
a0a786e3 EB |
655 | -- Now, check the projects directly imported by the main project. |
656 | -- Remove from the potentially virtual any project extended by one | |
0ea55619 AC |
657 | -- of these imported projects. |
658 | ||
a0a786e3 EB |
659 | declare |
660 | With_Clause : Project_Node_Id; | |
661 | Imported : Project_Node_Id := Empty_Node; | |
662 | Declaration : Project_Node_Id := Empty_Node; | |
9596236a | 663 | |
a0a786e3 EB |
664 | begin |
665 | With_Clause := First_With_Clause_Of (Project, In_Tree); | |
666 | while Present (With_Clause) loop | |
667 | Imported := Project_Node_Of (With_Clause, In_Tree); | |
9596236a | 668 | |
a0a786e3 EB |
669 | if Present (Imported) then |
670 | Declaration := Project_Declaration_Of (Imported, In_Tree); | |
671 | ||
672 | if Extended_Project_Of (Declaration, In_Tree) /= | |
673 | Empty_Node | |
674 | then | |
675 | loop | |
676 | Imported := | |
677 | Extended_Project_Of (Declaration, In_Tree); | |
678 | exit when No (Imported); | |
679 | Virtual_Hash.Remove (Imported); | |
680 | Declaration := | |
681 | Project_Declaration_Of (Imported, In_Tree); | |
682 | end loop; | |
9596236a | 683 | end if; |
a0a786e3 | 684 | end if; |
9596236a | 685 | |
a0a786e3 EB |
686 | With_Clause := Next_With_Clause_Of (With_Clause, In_Tree); |
687 | end loop; | |
688 | end; | |
9596236a | 689 | |
a0a786e3 | 690 | -- Now create all the virtual extending projects |
9596236a | 691 | |
a0a786e3 | 692 | declare |
ef992452 AC |
693 | Proj : Project_Node_Id := Empty_Node; |
694 | Withs : Project_Node_Id; | |
a0a786e3 | 695 | begin |
ef992452 AC |
696 | Virtual_Hash.Get_First (Proj, Withs); |
697 | while Withs /= Project_Node_High_Bound loop | |
698 | Create_Virtual_Extending_Project | |
699 | (Proj, Project, Withs, In_Tree); | |
700 | Virtual_Hash.Get_Next (Proj, Withs); | |
a0a786e3 EB |
701 | end loop; |
702 | end; | |
703 | end if; | |
19235870 | 704 | |
a0a786e3 EB |
705 | -- If there were any kind of error during the parsing, serious |
706 | -- or not, then the parsing fails. | |
07fc65c4 | 707 | |
ee2ba856 | 708 | if Total_Errors_Detected > 0 then |
a0a786e3 EB |
709 | Project := Empty_Node; |
710 | end if; | |
19235870 | 711 | |
c0e538ad AC |
712 | case Errout_Handling is |
713 | when Always_Finalize => | |
714 | Prj.Err.Finalize; | |
48eff283 | 715 | |
c0e538ad AC |
716 | -- Reinitialize to avoid duplicate warnings later on |
717 | Prj.Err.Initialize; | |
48eff283 | 718 | |
c0e538ad AC |
719 | when Finalize_If_Error => |
720 | if No (Project) then | |
721 | Prj.Err.Finalize; | |
722 | Prj.Err.Initialize; | |
723 | end if; | |
724 | ||
725 | when Never_Finalize => | |
726 | null; | |
727 | end case; | |
19235870 RK |
728 | |
729 | exception | |
730 | when X : others => | |
731 | ||
732 | -- Internal error | |
733 | ||
734 | Write_Line (Exception_Information (X)); | |
735 | Write_Str ("Exception "); | |
736 | Write_Str (Exception_Name (X)); | |
737 | Write_Line (" raised, while processing project file"); | |
738 | Project := Empty_Node; | |
739 | end Parse; | |
740 | ||
fbf5a39b AC |
741 | ------------------------------ |
742 | -- Pre_Parse_Context_Clause -- | |
743 | ------------------------------ | |
19235870 | 744 | |
7e98a4c6 VC |
745 | procedure Pre_Parse_Context_Clause |
746 | (In_Tree : Project_Node_Tree_Ref; | |
bd0a4cab | 747 | Context_Clause : out With_Id; |
e2d9085b EB |
748 | Is_Config_File : Boolean; |
749 | Flags : Processing_Flags) | |
7e98a4c6 | 750 | is |
6c1f47ee EB |
751 | Current_With_Clause : With_Id := No_With; |
752 | Limited_With : Boolean := False; | |
753 | Current_With : With_Record; | |
754 | Current_With_Node : Project_Node_Id := Empty_Node; | |
c45b6ae0 | 755 | |
19235870 RK |
756 | begin |
757 | -- Assume no context clause | |
758 | ||
fbf5a39b | 759 | Context_Clause := No_With; |
19235870 RK |
760 | With_Loop : |
761 | ||
7e98a4c6 VC |
762 | -- If Token is not WITH or LIMITED, there is no context clause, or we |
763 | -- have exhausted the with clauses. | |
19235870 | 764 | |
fbf5a39b | 765 | while Token = Tok_With or else Token = Tok_Limited loop |
7e98a4c6 VC |
766 | Current_With_Node := |
767 | Default_Project_Node (Of_Kind => N_With_Clause, In_Tree => In_Tree); | |
fbf5a39b AC |
768 | Limited_With := Token = Tok_Limited; |
769 | ||
bd0a4cab | 770 | if Is_Config_File then |
ede007da | 771 | Error_Msg |
e2d9085b EB |
772 | (Flags, |
773 | "configuration project cannot import " & | |
ede007da VC |
774 | "other configuration projects", |
775 | Token_Ptr); | |
776 | end if; | |
777 | ||
fbf5a39b | 778 | if Limited_With then |
cc96a1b8 | 779 | Scan (In_Tree); -- past LIMITED |
fbf5a39b AC |
780 | Expect (Tok_With, "WITH"); |
781 | exit With_Loop when Token /= Tok_With; | |
782 | end if; | |
783 | ||
19235870 RK |
784 | Comma_Loop : |
785 | loop | |
1a5d715a | 786 | Scan (In_Tree); -- past WITH or "," |
19235870 | 787 | |
19235870 RK |
788 | Expect (Tok_String_Literal, "literal string"); |
789 | ||
790 | if Token /= Tok_String_Literal then | |
791 | return; | |
792 | end if; | |
793 | ||
fbf5a39b | 794 | -- Store path and location in table Withs |
19235870 | 795 | |
fbf5a39b | 796 | Current_With := |
ede007da | 797 | (Path => Path_Name_Type (Token_Name), |
fbf5a39b AC |
798 | Location => Token_Ptr, |
799 | Limited_With => Limited_With, | |
c45b6ae0 | 800 | Node => Current_With_Node, |
fbf5a39b | 801 | Next => No_With); |
19235870 | 802 | |
fbf5a39b AC |
803 | Withs.Increment_Last; |
804 | Withs.Table (Withs.Last) := Current_With; | |
19235870 | 805 | |
fbf5a39b AC |
806 | if Current_With_Clause = No_With then |
807 | Context_Clause := Withs.Last; | |
19235870 | 808 | |
fbf5a39b AC |
809 | else |
810 | Withs.Table (Current_With_Clause).Next := Withs.Last; | |
811 | end if; | |
812 | ||
813 | Current_With_Clause := Withs.Last; | |
19235870 | 814 | |
7e98a4c6 | 815 | Scan (In_Tree); |
19235870 | 816 | |
fbf5a39b | 817 | if Token = Tok_Semicolon then |
c45b6ae0 AC |
818 | Set_End_Of_Line (Current_With_Node); |
819 | Set_Previous_Line_Node (Current_With_Node); | |
19235870 | 820 | |
fbf5a39b | 821 | -- End of (possibly multiple) with clause; |
19235870 | 822 | |
cc96a1b8 | 823 | Scan (In_Tree); -- past semicolon |
fbf5a39b | 824 | exit Comma_Loop; |
07fc65c4 | 825 | |
a493557f VC |
826 | elsif Token = Tok_Comma then |
827 | Set_Is_Not_Last_In_List (Current_With_Node, In_Tree); | |
828 | ||
829 | else | |
e2d9085b | 830 | Error_Msg (Flags, "expected comma or semi colon", Token_Ptr); |
fbf5a39b AC |
831 | exit Comma_Loop; |
832 | end if; | |
c45b6ae0 AC |
833 | |
834 | Current_With_Node := | |
7e98a4c6 VC |
835 | Default_Project_Node |
836 | (Of_Kind => N_With_Clause, In_Tree => In_Tree); | |
fbf5a39b AC |
837 | end loop Comma_Loop; |
838 | end loop With_Loop; | |
839 | end Pre_Parse_Context_Clause; | |
07fc65c4 | 840 | |
fbf5a39b AC |
841 | ------------------------------- |
842 | -- Post_Parse_Context_Clause -- | |
843 | ------------------------------- | |
07fc65c4 | 844 | |
fbf5a39b AC |
845 | procedure Post_Parse_Context_Clause |
846 | (Context_Clause : With_Id; | |
7e98a4c6 | 847 | In_Tree : Project_Node_Tree_Ref; |
07ef182e | 848 | In_Limited : Boolean; |
1a5d715a VC |
849 | Limited_Withs : Boolean; |
850 | Imported_Projects : in out Project_Node_Id; | |
39f4e199 | 851 | Project_Directory : Path_Name_Type; |
0da2c8ac | 852 | From_Extended : Extension_Origin; |
ede007da | 853 | Packages_To_Check : String_List_Access; |
6c1f47ee | 854 | Depth : Natural; |
bd0a4cab | 855 | Current_Dir : String; |
e2d9085b | 856 | Is_Config_File : Boolean; |
4437a530 | 857 | Env : in out Environment) |
fbf5a39b | 858 | is |
ede007da | 859 | Current_With_Clause : With_Id := Context_Clause; |
07fc65c4 | 860 | |
1a5d715a | 861 | Current_Project : Project_Node_Id := Imported_Projects; |
fbf5a39b AC |
862 | Previous_Project : Project_Node_Id := Empty_Node; |
863 | Next_Project : Project_Node_Id := Empty_Node; | |
07fc65c4 | 864 | |
fbf5a39b AC |
865 | Project_Directory_Path : constant String := |
866 | Get_Name_String (Project_Directory); | |
07fc65c4 | 867 | |
fbf5a39b | 868 | Current_With : With_Record; |
b7e429ab | 869 | Extends_All : Boolean := False; |
a0a786e3 | 870 | Imported_Path_Name_Id : Path_Name_Type; |
07fc65c4 | 871 | |
fbf5a39b | 872 | begin |
1a5d715a VC |
873 | -- Set Current_Project to the last project in the current list, if the |
874 | -- list is not empty. | |
875 | ||
4f469be3 | 876 | if Present (Current_Project) then |
1a5d715a | 877 | while |
4f469be3 | 878 | Present (Next_With_Clause_Of (Current_Project, In_Tree)) |
1a5d715a VC |
879 | loop |
880 | Current_Project := Next_With_Clause_Of (Current_Project, In_Tree); | |
881 | end loop; | |
882 | end if; | |
19235870 | 883 | |
fbf5a39b AC |
884 | while Current_With_Clause /= No_With loop |
885 | Current_With := Withs.Table (Current_With_Clause); | |
886 | Current_With_Clause := Current_With.Next; | |
887 | ||
1a5d715a | 888 | if Limited_Withs = Current_With.Limited_With then |
a0a786e3 | 889 | Find_Project |
4437a530 | 890 | (Env.Project_Path, |
a0a786e3 EB |
891 | Project_File_Name => Get_Name_String (Current_With.Path), |
892 | Directory => Project_Directory_Path, | |
a96ca600 | 893 | Path => Imported_Path_Name_Id); |
fbf5a39b | 894 | |
a0a786e3 | 895 | if Imported_Path_Name_Id = No_Path then |
0180fd26 AC |
896 | if Env.Flags.Ignore_Missing_With then |
897 | In_Tree.Incomplete_With := True; | |
3dfe4883 | 898 | Env.Flags.Incomplete_Withs := True; |
0180fd26 AC |
899 | |
900 | else | |
901 | -- The project file cannot be found | |
902 | ||
903 | Error_Msg_File_1 := File_Name_Type (Current_With.Path); | |
904 | Error_Msg | |
905 | (Env.Flags, "unknown project file: {", | |
906 | Current_With.Location); | |
907 | ||
908 | -- If this is not imported by the main project file, display | |
909 | -- the import path. | |
910 | ||
911 | if Project_Stack.Last > 1 then | |
912 | for Index in reverse 1 .. Project_Stack.Last loop | |
913 | Error_Msg_File_1 := | |
914 | File_Name_Type | |
915 | (Project_Stack.Table (Index).Path_Name); | |
916 | Error_Msg | |
917 | (Env.Flags, "\imported by {", Current_With.Location); | |
918 | end loop; | |
919 | end if; | |
a0a786e3 | 920 | end if; |
19235870 | 921 | |
a0a786e3 EB |
922 | else |
923 | -- New with clause | |
19235870 | 924 | |
a0a786e3 EB |
925 | declare |
926 | Resolved_Path : constant String := | |
927 | Normalize_Pathname | |
928 | (Get_Name_String (Imported_Path_Name_Id), | |
929 | Directory => Current_Dir, | |
930 | Resolve_Links => | |
931 | Opt.Follow_Links_For_Files, | |
932 | Case_Sensitive => True); | |
19235870 | 933 | |
a0a786e3 | 934 | Withed_Project : Project_Node_Id := Empty_Node; |
19235870 | 935 | |
a0a786e3 | 936 | begin |
1a5d715a | 937 | Previous_Project := Current_Project; |
19235870 | 938 | |
4f469be3 | 939 | if No (Current_Project) then |
fbf5a39b | 940 | |
1a5d715a | 941 | -- First with clause of the context clause |
fbf5a39b | 942 | |
1a5d715a VC |
943 | Current_Project := Current_With.Node; |
944 | Imported_Projects := Current_Project; | |
fbf5a39b | 945 | |
1a5d715a VC |
946 | else |
947 | Next_Project := Current_With.Node; | |
948 | Set_Next_With_Clause_Of | |
949 | (Current_Project, In_Tree, Next_Project); | |
950 | Current_Project := Next_Project; | |
951 | end if; | |
fbf5a39b | 952 | |
1a5d715a VC |
953 | Set_String_Value_Of |
954 | (Current_Project, | |
955 | In_Tree, | |
956 | Name_Id (Current_With.Path)); | |
957 | Set_Location_Of | |
958 | (Current_Project, In_Tree, Current_With.Location); | |
959 | ||
960 | -- If it is a limited with, check if we have a circularity. | |
961 | -- If we have one, get the project id of the limited | |
962 | -- imported project file, and do not parse it. | |
963 | ||
9a6dc470 RD |
964 | if (In_Limited or Limited_Withs) |
965 | and then Project_Stack.Last > 1 | |
07ef182e | 966 | then |
1a5d715a VC |
967 | declare |
968 | Canonical_Path_Name : Path_Name_Type; | |
969 | ||
970 | begin | |
971 | Name_Len := Resolved_Path'Length; | |
972 | Name_Buffer (1 .. Name_Len) := Resolved_Path; | |
973 | Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); | |
974 | Canonical_Path_Name := Name_Find; | |
975 | ||
976 | for Index in 1 .. Project_Stack.Last loop | |
977 | if Project_Stack.Table (Index).Canonical_Path_Name = | |
978 | Canonical_Path_Name | |
979 | then | |
980 | -- We have found the limited imported project, | |
981 | -- get its project id, and do not parse it. | |
fbf5a39b | 982 | |
1a5d715a VC |
983 | Withed_Project := Project_Stack.Table (Index).Id; |
984 | exit; | |
985 | end if; | |
986 | end loop; | |
987 | end; | |
988 | end if; | |
fbf5a39b | 989 | |
9a6dc470 | 990 | -- Parse the imported project if its project id is unknown |
fbf5a39b | 991 | |
4f469be3 | 992 | if No (Withed_Project) then |
1a5d715a VC |
993 | Parse_Single_Project |
994 | (In_Tree => In_Tree, | |
995 | Project => Withed_Project, | |
996 | Extends_All => Extends_All, | |
a0a786e3 | 997 | Path_Name_Id => Imported_Path_Name_Id, |
1a5d715a VC |
998 | Extended => False, |
999 | From_Extended => From_Extended, | |
9a6dc470 | 1000 | In_Limited => In_Limited or Limited_Withs, |
1a5d715a VC |
1001 | Packages_To_Check => Packages_To_Check, |
1002 | Depth => Depth, | |
bd0a4cab | 1003 | Current_Dir => Current_Dir, |
e2d9085b | 1004 | Is_Config_File => Is_Config_File, |
4437a530 | 1005 | Env => Env); |
fbf5a39b | 1006 | |
1a5d715a VC |
1007 | else |
1008 | Extends_All := Is_Extending_All (Withed_Project, In_Tree); | |
1009 | end if; | |
b7e429ab | 1010 | |
4f469be3 | 1011 | if No (Withed_Project) then |
fbf5a39b | 1012 | |
1a5d715a | 1013 | -- If parsing unsuccessful, remove the context clause |
fbf5a39b | 1014 | |
1a5d715a | 1015 | Current_Project := Previous_Project; |
fbf5a39b | 1016 | |
4f469be3 | 1017 | if No (Current_Project) then |
1a5d715a | 1018 | Imported_Projects := Empty_Node; |
fbf5a39b | 1019 | |
1a5d715a VC |
1020 | else |
1021 | Set_Next_With_Clause_Of | |
1022 | (Current_Project, In_Tree, Empty_Node); | |
1023 | end if; | |
fbf5a39b | 1024 | else |
1a5d715a VC |
1025 | -- If parsing was successful, record project name and |
1026 | -- path name in with clause | |
1027 | ||
1028 | Set_Project_Node_Of | |
1029 | (Node => Current_Project, | |
1030 | In_Tree => In_Tree, | |
1031 | To => Withed_Project, | |
1032 | Limited_With => Current_With.Limited_With); | |
1033 | Set_Name_Of | |
1034 | (Current_Project, | |
1035 | In_Tree, | |
1036 | Name_Of (Withed_Project, In_Tree)); | |
9a080ea3 | 1037 | |
1a5d715a VC |
1038 | Name_Len := Resolved_Path'Length; |
1039 | Name_Buffer (1 .. Name_Len) := Resolved_Path; | |
1040 | Set_Path_Name_Of (Current_Project, In_Tree, Name_Find); | |
b7e429ab | 1041 | |
1a5d715a VC |
1042 | if Extends_All then |
1043 | Set_Is_Extending_All (Current_Project, In_Tree); | |
1044 | end if; | |
b7e429ab | 1045 | end if; |
a0a786e3 EB |
1046 | end; |
1047 | end if; | |
1a5d715a | 1048 | end if; |
fbf5a39b AC |
1049 | end loop; |
1050 | end Post_Parse_Context_Clause; | |
19235870 | 1051 | |
9d9f5f49 AC |
1052 | --------------------------------- |
1053 | -- Check_Extending_All_Imports -- | |
1054 | --------------------------------- | |
1055 | ||
1056 | procedure Check_Extending_All_Imports | |
1057 | (Flags : Processing_Flags; | |
1058 | In_Tree : Project_Node_Tree_Ref; | |
1059 | Project : Project_Node_Id) | |
1060 | is | |
3ce5ca75 RD |
1061 | With_Clause : Project_Node_Id; |
1062 | Imported : Project_Node_Id; | |
1063 | ||
9d9f5f49 AC |
1064 | begin |
1065 | if not Is_Extending_All (Project, In_Tree) then | |
1066 | With_Clause := First_With_Clause_Of (Project, In_Tree); | |
9d9f5f49 AC |
1067 | while Present (With_Clause) loop |
1068 | Imported := Project_Node_Of (With_Clause, In_Tree); | |
1069 | ||
1070 | if Is_Extending_All (With_Clause, In_Tree) then | |
1071 | Error_Msg_Name_1 := Name_Of (Imported, In_Tree); | |
1072 | Error_Msg (Flags, "cannot import extending-all project %%", | |
1073 | Token_Ptr); | |
1074 | exit; | |
1075 | end if; | |
1076 | ||
1077 | With_Clause := Next_With_Clause_Of (With_Clause, In_Tree); | |
1078 | end loop; | |
1079 | end if; | |
1080 | end Check_Extending_All_Imports; | |
1081 | ||
1082 | ----------------------------- | |
1083 | -- Check_Aggregate_Imports -- | |
1084 | ----------------------------- | |
1085 | ||
1086 | procedure Check_Aggregate_Imports | |
1087 | (Flags : Processing_Flags; | |
1088 | In_Tree : Project_Node_Tree_Ref; | |
1089 | Project : Project_Node_Id) | |
1090 | is | |
1091 | With_Clause, Imported : Project_Node_Id; | |
1092 | begin | |
1093 | if Project_Qualifier_Of (Project, In_Tree) = Aggregate then | |
1094 | With_Clause := First_With_Clause_Of (Project, In_Tree); | |
1095 | ||
1096 | while Present (With_Clause) loop | |
1097 | Imported := Project_Node_Of (With_Clause, In_Tree); | |
1098 | ||
af6478c8 AC |
1099 | if Project_Qualifier_Of (Imported, In_Tree) /= Abstract_Project |
1100 | then | |
9d9f5f49 AC |
1101 | Error_Msg_Name_1 := Name_Id (Path_Name_Of (Imported, In_Tree)); |
1102 | Error_Msg (Flags, "can only import abstract projects, not %%", | |
1103 | Token_Ptr); | |
1104 | exit; | |
1105 | end if; | |
1106 | ||
1107 | With_Clause := Next_With_Clause_Of (With_Clause, In_Tree); | |
1108 | end loop; | |
1109 | end if; | |
1110 | end Check_Aggregate_Imports; | |
1111 | ||
88de755d VC |
1112 | ---------------------------- |
1113 | -- Check_Import_Aggregate -- | |
1114 | ---------------------------- | |
1115 | ||
1116 | procedure Check_Import_Aggregate | |
1117 | (Flags : Processing_Flags; | |
1118 | In_Tree : Project_Node_Tree_Ref; | |
1119 | Project : Project_Node_Id) | |
1120 | is | |
a4ab03b0 AC |
1121 | With_Clause : Project_Node_Id; |
1122 | Imported : Project_Node_Id; | |
1123 | ||
88de755d VC |
1124 | begin |
1125 | if Project_Qualifier_Of (Project, In_Tree) /= Aggregate then | |
1126 | With_Clause := First_With_Clause_Of (Project, In_Tree); | |
88de755d VC |
1127 | while Present (With_Clause) loop |
1128 | Imported := Project_Node_Of (With_Clause, In_Tree); | |
1129 | ||
1130 | if Project_Qualifier_Of (Imported, In_Tree) = Aggregate then | |
1131 | Error_Msg_Name_1 := Name_Id (Path_Name_Of (Imported, In_Tree)); | |
13f39091 AC |
1132 | Error_Msg |
1133 | (Flags, "cannot import aggregate project %%", Token_Ptr); | |
88de755d VC |
1134 | exit; |
1135 | end if; | |
1136 | ||
1137 | With_Clause := Next_With_Clause_Of (With_Clause, In_Tree); | |
1138 | end loop; | |
1139 | end if; | |
1140 | end Check_Import_Aggregate; | |
1141 | ||
9d9f5f49 AC |
1142 | ---------------------------- |
1143 | -- Read_Project_Qualifier -- | |
1144 | ---------------------------- | |
1145 | ||
1146 | procedure Read_Project_Qualifier | |
1147 | (Flags : Processing_Flags; | |
1148 | In_Tree : Project_Node_Tree_Ref; | |
1149 | Is_Config_File : Boolean; | |
1150 | Qualifier_Location : out Source_Ptr; | |
1151 | Project : Project_Node_Id) | |
1152 | is | |
1153 | Proj_Qualifier : Project_Qualifier := Unspecified; | |
1154 | begin | |
1155 | Qualifier_Location := Token_Ptr; | |
1156 | ||
1157 | if Token = Tok_Abstract then | |
af6478c8 | 1158 | Proj_Qualifier := Abstract_Project; |
9d9f5f49 AC |
1159 | Scan (In_Tree); |
1160 | ||
1161 | elsif Token = Tok_Identifier then | |
1162 | case Token_Name is | |
1163 | when Snames.Name_Standard => | |
1164 | Proj_Qualifier := Standard; | |
1165 | Scan (In_Tree); | |
1166 | ||
1167 | when Snames.Name_Aggregate => | |
1168 | Proj_Qualifier := Aggregate; | |
1169 | Scan (In_Tree); | |
1170 | ||
1bb6e262 AC |
1171 | if Token = Tok_Identifier |
1172 | and then Token_Name = Snames.Name_Library | |
9d9f5f49 AC |
1173 | then |
1174 | Proj_Qualifier := Aggregate_Library; | |
1175 | Scan (In_Tree); | |
1176 | end if; | |
1177 | ||
1178 | when Snames.Name_Library => | |
1179 | Proj_Qualifier := Library; | |
1180 | Scan (In_Tree); | |
1181 | ||
1182 | when Snames.Name_Configuration => | |
1183 | if not Is_Config_File then | |
1184 | Error_Msg | |
1185 | (Flags, | |
1186 | "configuration projects cannot belong to a user" & | |
1187 | " project tree", | |
1188 | Token_Ptr); | |
1189 | end if; | |
1190 | ||
1191 | Proj_Qualifier := Configuration; | |
1192 | Scan (In_Tree); | |
1193 | ||
1194 | when others => | |
1195 | null; | |
1196 | end case; | |
1197 | end if; | |
1198 | ||
1199 | if Is_Config_File and then Proj_Qualifier = Unspecified then | |
1200 | ||
1201 | -- Set the qualifier to Configuration, even if the token doesn't | |
1202 | -- exist in the source file itself, so that we can differentiate | |
1203 | -- project files and configuration files later on. | |
1204 | ||
1205 | Proj_Qualifier := Configuration; | |
1206 | end if; | |
1207 | ||
1208 | if Proj_Qualifier /= Unspecified then | |
1209 | if Is_Config_File | |
1210 | and then Proj_Qualifier /= Configuration | |
1211 | then | |
1212 | Error_Msg (Flags, | |
1213 | "a configuration project cannot be qualified except " & | |
1214 | "as configuration project", | |
1215 | Qualifier_Location); | |
1216 | end if; | |
1217 | ||
1218 | Set_Project_Qualifier_Of (Project, In_Tree, Proj_Qualifier); | |
1219 | end if; | |
1220 | end Read_Project_Qualifier; | |
1221 | ||
1222 | ------------------------------- | |
1223 | -- Has_Circular_Dependencies -- | |
1224 | ------------------------------- | |
1225 | ||
1226 | function Has_Circular_Dependencies | |
1227 | (Flags : Processing_Flags; | |
1228 | Normed_Path_Name : Path_Name_Type; | |
1229 | Canonical_Path_Name : Path_Name_Type) return Boolean is | |
1230 | begin | |
1231 | for Index in reverse 1 .. Project_Stack.Last loop | |
1232 | exit when Project_Stack.Table (Index).Limited_With; | |
1233 | ||
1234 | if Canonical_Path_Name = | |
1235 | Project_Stack.Table (Index).Canonical_Path_Name | |
1236 | then | |
1237 | Error_Msg (Flags, "circular dependency detected", Token_Ptr); | |
1238 | Error_Msg_Name_1 := Name_Id (Normed_Path_Name); | |
1239 | Error_Msg (Flags, "\ %% is imported by", Token_Ptr); | |
1240 | ||
1241 | for Current in reverse 1 .. Project_Stack.Last loop | |
1242 | Error_Msg_Name_1 := | |
1243 | Name_Id (Project_Stack.Table (Current).Path_Name); | |
1244 | ||
1245 | if Project_Stack.Table (Current).Canonical_Path_Name /= | |
1246 | Canonical_Path_Name | |
1247 | then | |
1248 | Error_Msg | |
1249 | (Flags, "\ %% which itself is imported by", Token_Ptr); | |
1250 | ||
1251 | else | |
1252 | Error_Msg (Flags, "\ %%", Token_Ptr); | |
1253 | exit; | |
1254 | end if; | |
1255 | end loop; | |
1256 | ||
1257 | return True; | |
1258 | end if; | |
1259 | end loop; | |
1260 | return False; | |
1261 | end Has_Circular_Dependencies; | |
1262 | ||
19235870 RK |
1263 | -------------------------- |
1264 | -- Parse_Single_Project -- | |
1265 | -------------------------- | |
1266 | ||
1267 | procedure Parse_Single_Project | |
7e98a4c6 VC |
1268 | (In_Tree : Project_Node_Tree_Ref; |
1269 | Project : out Project_Node_Id; | |
1270 | Extends_All : out Boolean; | |
a0a786e3 | 1271 | Path_Name_Id : Path_Name_Type; |
7e98a4c6 VC |
1272 | Extended : Boolean; |
1273 | From_Extended : Extension_Origin; | |
1274 | In_Limited : Boolean; | |
ede007da | 1275 | Packages_To_Check : String_List_Access; |
6c1f47ee | 1276 | Depth : Natural; |
bd0a4cab | 1277 | Current_Dir : String; |
e2d9085b | 1278 | Is_Config_File : Boolean; |
9d5598bf AC |
1279 | Env : in out Environment; |
1280 | Implicit_Project : Boolean := False) | |
19235870 | 1281 | is |
a0a786e3 EB |
1282 | Path_Name : constant String := Get_Name_String (Path_Name_Id); |
1283 | ||
39f4e199 VC |
1284 | Normed_Path_Name : Path_Name_Type; |
1285 | Canonical_Path_Name : Path_Name_Type; | |
13f39091 | 1286 | Resolved_Path_Name : Path_Name_Type; |
39f4e199 | 1287 | Project_Directory : Path_Name_Type; |
19235870 RK |
1288 | Project_Scan_State : Saved_Project_Scan_State; |
1289 | Source_Index : Source_File_Index; | |
1290 | ||
5c1c8a03 AC |
1291 | Extending : Boolean := False; |
1292 | ||
1a5d715a | 1293 | Extended_Project : Project_Node_Id := Empty_Node; |
19235870 RK |
1294 | |
1295 | A_Project_Name_And_Node : Tree_Private_Part.Project_Name_And_Node := | |
7e98a4c6 VC |
1296 | Tree_Private_Part.Projects_Htable.Get_First |
1297 | (In_Tree.Projects_HT); | |
19235870 | 1298 | |
bd0a4cab EB |
1299 | Name_From_Path : constant Name_Id := |
1300 | Project_Name_From (Path_Name, Is_Config_File => Is_Config_File); | |
4f469be3 VC |
1301 | Name_Of_Project : Name_Id := No_Name; |
1302 | ||
1303 | Duplicated : Boolean := False; | |
1304 | ||
1a5d715a VC |
1305 | First_With : With_Id; |
1306 | Imported_Projects : Project_Node_Id := Empty_Node; | |
fbf5a39b | 1307 | |
19235870 RK |
1308 | use Tree_Private_Part; |
1309 | ||
c45b6ae0 AC |
1310 | Project_Comment_State : Tree.Comment_State; |
1311 | ||
68c3f02a VC |
1312 | Qualifier_Location : Source_Ptr; |
1313 | ||
19235870 | 1314 | begin |
b7e429ab AC |
1315 | Extends_All := False; |
1316 | ||
fbf5a39b | 1317 | declare |
2820d220 | 1318 | Normed_Path : constant String := Normalize_Pathname |
6c1f47ee EB |
1319 | (Path_Name, |
1320 | Directory => Current_Dir, | |
1321 | Resolve_Links => False, | |
1322 | Case_Sensitive => True); | |
6d11af89 | 1323 | Canonical_Path : constant String := Normalize_Pathname |
6c1f47ee EB |
1324 | (Normed_Path, |
1325 | Directory => Current_Dir, | |
1326 | Resolve_Links => Opt.Follow_Links_For_Files, | |
1327 | Case_Sensitive => False); | |
fbf5a39b | 1328 | begin |
6d11af89 AC |
1329 | Name_Len := Normed_Path'Length; |
1330 | Name_Buffer (1 .. Name_Len) := Normed_Path; | |
fbf5a39b | 1331 | Normed_Path_Name := Name_Find; |
6d11af89 AC |
1332 | Name_Len := Canonical_Path'Length; |
1333 | Name_Buffer (1 .. Name_Len) := Canonical_Path; | |
fbf5a39b | 1334 | Canonical_Path_Name := Name_Find; |
13f39091 AC |
1335 | |
1336 | if Opt.Follow_Links_For_Files then | |
1337 | Resolved_Path_Name := Canonical_Path_Name; | |
1338 | ||
1339 | else | |
1340 | Name_Len := 0; | |
1341 | Add_Str_To_Name_Buffer | |
1342 | (Normalize_Pathname | |
1343 | (Canonical_Path, | |
1344 | Resolve_Links => True, | |
1345 | Case_Sensitive => False)); | |
1346 | Resolved_Path_Name := Name_Find; | |
1347 | end if; | |
1348 | ||
fbf5a39b | 1349 | end; |
19235870 | 1350 | |
9d9f5f49 | 1351 | if Has_Circular_Dependencies |
4437a530 | 1352 | (Env.Flags, Normed_Path_Name, Canonical_Path_Name) |
9d9f5f49 AC |
1353 | then |
1354 | Project := Empty_Node; | |
1355 | return; | |
1356 | end if; | |
19235870 | 1357 | |
c45b6ae0 AC |
1358 | -- Put the new path name on the stack |
1359 | ||
1a5d715a VC |
1360 | Project_Stack.Append |
1361 | ((Path_Name => Normed_Path_Name, | |
1362 | Canonical_Path_Name => Canonical_Path_Name, | |
1363 | Id => Empty_Node, | |
1364 | Limited_With => In_Limited)); | |
19235870 | 1365 | |
44e1918a | 1366 | -- Check if the project file has already been parsed |
19235870 RK |
1367 | |
1368 | while | |
1369 | A_Project_Name_And_Node /= Tree_Private_Part.No_Project_Name_And_Node | |
1370 | loop | |
13f39091 | 1371 | if A_Project_Name_And_Node.Resolved_Path = Resolved_Path_Name then |
44e1918a | 1372 | if Extended then |
19235870 | 1373 | |
44e1918a | 1374 | if A_Project_Name_And_Node.Extended then |
af6478c8 AC |
1375 | if A_Project_Name_And_Node.Proj_Qualifier /= Abstract_Project |
1376 | then | |
4f469be3 | 1377 | Error_Msg |
4437a530 | 1378 | (Env.Flags, |
e2d9085b | 1379 | "cannot extend the same project file several times", |
4f469be3 VC |
1380 | Token_Ptr); |
1381 | end if; | |
579847c2 | 1382 | elsif not A_Project_Name_And_Node.From_Extended then |
44e1918a | 1383 | Error_Msg |
4437a530 | 1384 | (Env.Flags, |
e2d9085b | 1385 | "cannot extend an already imported project file", |
44e1918a | 1386 | Token_Ptr); |
579847c2 AC |
1387 | |
1388 | else | |
1389 | -- Register this project as being extended | |
1390 | ||
1391 | A_Project_Name_And_Node.Extended := True; | |
1392 | Tree_Private_Part.Projects_Htable.Set | |
1393 | (In_Tree.Projects_HT, | |
1394 | A_Project_Name_And_Node.Name, | |
1395 | A_Project_Name_And_Node); | |
44e1918a | 1396 | end if; |
fbf5a39b | 1397 | |
44e1918a AC |
1398 | elsif A_Project_Name_And_Node.Extended then |
1399 | Extends_All := | |
7e98a4c6 | 1400 | Is_Extending_All (A_Project_Name_And_Node.Node, In_Tree); |
6871ba5f | 1401 | |
1a5d715a VC |
1402 | -- If the imported project is an extended project A, and we are |
1403 | -- in an extended project, replace A with the ultimate project | |
1404 | -- extending A. | |
6871ba5f | 1405 | |
44e1918a AC |
1406 | if From_Extended /= None then |
1407 | declare | |
1408 | Decl : Project_Node_Id := | |
1409 | Project_Declaration_Of | |
7e98a4c6 | 1410 | (A_Project_Name_And_Node.Node, In_Tree); |
8a7988f5 | 1411 | |
7e98a4c6 | 1412 | Prj : Project_Node_Id := |
0ec21a5b | 1413 | A_Project_Name_And_Node.Node; |
8a7988f5 | 1414 | |
44e1918a | 1415 | begin |
1933c497 AC |
1416 | -- Loop through extending projects to find the ultimate |
1417 | -- extending project, that is the one that is not | |
107b023c AC |
1418 | -- extended. For an abstract project, as it can be |
1419 | -- extended several times, there is no extending project | |
1420 | -- registered, so the loop does not execute and the | |
1421 | -- resulting project is the abstract project. | |
1933c497 | 1422 | |
0ec21a5b AC |
1423 | while |
1424 | Extending_Project_Of (Decl, In_Tree) /= Empty_Node | |
44e1918a | 1425 | loop |
7e98a4c6 | 1426 | Prj := Extending_Project_Of (Decl, In_Tree); |
0ec21a5b | 1427 | Decl := Project_Declaration_Of (Prj, In_Tree); |
44e1918a | 1428 | end loop; |
fbf5a39b | 1429 | |
44e1918a AC |
1430 | A_Project_Name_And_Node.Node := Prj; |
1431 | end; | |
1432 | else | |
1433 | Error_Msg | |
4437a530 | 1434 | (Env.Flags, |
e2d9085b | 1435 | "cannot import an already extended project file", |
44e1918a | 1436 | Token_Ptr); |
fbf5a39b | 1437 | end if; |
579847c2 AC |
1438 | |
1439 | elsif A_Project_Name_And_Node.From_Extended then | |
1440 | -- This project is now imported from a non extending project. | |
1441 | -- Indicate this in has table Projects.HT. | |
1442 | ||
1443 | A_Project_Name_And_Node.From_Extended := False; | |
1444 | Tree_Private_Part.Projects_Htable.Set | |
1445 | (In_Tree.Projects_HT, | |
1446 | A_Project_Name_And_Node.Name, | |
1447 | A_Project_Name_And_Node); | |
6871ba5f | 1448 | end if; |
44e1918a AC |
1449 | |
1450 | Project := A_Project_Name_And_Node.Node; | |
1451 | Project_Stack.Decrement_Last; | |
1452 | return; | |
1453 | end if; | |
19235870 | 1454 | |
7e98a4c6 VC |
1455 | A_Project_Name_And_Node := |
1456 | Tree_Private_Part.Projects_Htable.Get_Next (In_Tree.Projects_HT); | |
19235870 RK |
1457 | end loop; |
1458 | ||
1a5d715a VC |
1459 | -- We never encountered this project file. Save the scan state, load the |
1460 | -- project file and start to scan it. | |
19235870 RK |
1461 | |
1462 | Save_Project_Scan_State (Project_Scan_State); | |
1463 | Source_Index := Load_Project_File (Path_Name); | |
c45b6ae0 | 1464 | Tree.Save (Project_Comment_State); |
19235870 | 1465 | |
8a7988f5 | 1466 | -- If we cannot find it, we stop |
19235870 RK |
1467 | |
1468 | if Source_Index = No_Source_File then | |
1469 | Project := Empty_Node; | |
1470 | Project_Stack.Decrement_Last; | |
1471 | return; | |
1472 | end if; | |
1473 | ||
68e2ea27 | 1474 | Prj.Err.Scanner.Initialize_Scanner (Source_Index); |
c45b6ae0 | 1475 | Tree.Reset_State; |
7e98a4c6 | 1476 | Scan (In_Tree); |
19235870 | 1477 | |
9d5598bf AC |
1478 | if not Is_Config_File |
1479 | and then Name_From_Path = No_Name | |
1480 | and then not Implicit_Project | |
1481 | then | |
19235870 | 1482 | |
1a5d715a VC |
1483 | -- The project file name is not correct (no or bad extension, or not |
1484 | -- following Ada identifier's syntax). | |
19235870 | 1485 | |
39f4e199 | 1486 | Error_Msg_File_1 := File_Name_Type (Canonical_Path_Name); |
4437a530 | 1487 | Error_Msg (Env.Flags, |
e2d9085b | 1488 | "?{ is not a valid path name for a project file", |
1b685674 | 1489 | Token_Ptr); |
19235870 RK |
1490 | end if; |
1491 | ||
1492 | if Current_Verbosity >= Medium then | |
3e582869 | 1493 | Debug_Increase_Indent ("Parsing """ & Path_Name & '"'); |
19235870 RK |
1494 | end if; |
1495 | ||
32404665 EB |
1496 | Project_Directory := |
1497 | Path_Name_Type (Get_Directory (File_Name_Type (Normed_Path_Name))); | |
1a5d715a | 1498 | |
c45b6ae0 AC |
1499 | -- Is there any imported project? |
1500 | ||
1a5d715a VC |
1501 | Pre_Parse_Context_Clause |
1502 | (In_Tree => In_Tree, | |
bd0a4cab | 1503 | Is_Config_File => Is_Config_File, |
e2d9085b | 1504 | Context_Clause => First_With, |
4437a530 | 1505 | Flags => Env.Flags); |
c45b6ae0 | 1506 | |
7e98a4c6 VC |
1507 | Project := Default_Project_Node |
1508 | (Of_Kind => N_Project, In_Tree => In_Tree); | |
fbf5a39b | 1509 | Project_Stack.Table (Project_Stack.Last).Id := Project; |
7e98a4c6 VC |
1510 | Set_Directory_Of (Project, In_Tree, Project_Directory); |
1511 | Set_Path_Name_Of (Project, In_Tree, Normed_Path_Name); | |
68c3f02a | 1512 | |
9d9f5f49 | 1513 | Read_Project_Qualifier |
4437a530 | 1514 | (Env.Flags, In_Tree, Is_Config_File, Qualifier_Location, Project); |
68c3f02a VC |
1515 | |
1516 | Set_Location_Of (Project, In_Tree, Token_Ptr); | |
1517 | ||
fbf5a39b | 1518 | Expect (Tok_Project, "PROJECT"); |
19235870 | 1519 | |
6663c393 | 1520 | -- Mark location of PROJECT token if present |
19235870 RK |
1521 | |
1522 | if Token = Tok_Project then | |
1a5d715a | 1523 | Scan (In_Tree); -- past PROJECT |
7e98a4c6 | 1524 | Set_Location_Of (Project, In_Tree, Token_Ptr); |
19235870 RK |
1525 | end if; |
1526 | ||
fbf5a39b AC |
1527 | -- Clear the Buffer |
1528 | ||
1529 | Buffer_Last := 0; | |
fbf5a39b AC |
1530 | loop |
1531 | Expect (Tok_Identifier, "identifier"); | |
1532 | ||
1533 | -- If the token is not an identifier, clear the buffer before | |
1534 | -- exiting to indicate that the name of the project is ill-formed. | |
1535 | ||
1536 | if Token /= Tok_Identifier then | |
1537 | Buffer_Last := 0; | |
1538 | exit; | |
1539 | end if; | |
1540 | ||
1541 | -- Add the identifier name to the buffer | |
19235870 RK |
1542 | |
1543 | Get_Name_String (Token_Name); | |
7e98a4c6 | 1544 | Add_To_Buffer (Name_Buffer (1 .. Name_Len), Buffer, Buffer_Last); |
fbf5a39b AC |
1545 | |
1546 | -- Scan past the identifier | |
1547 | ||
7e98a4c6 | 1548 | Scan (In_Tree); |
fbf5a39b | 1549 | |
ede007da | 1550 | -- If we have a dot, add a dot to the Buffer and look for the next |
fbf5a39b AC |
1551 | -- identifier. |
1552 | ||
1553 | exit when Token /= Tok_Dot; | |
7e98a4c6 | 1554 | Add_To_Buffer (".", Buffer, Buffer_Last); |
fbf5a39b AC |
1555 | |
1556 | -- Scan past the dot | |
1557 | ||
7e98a4c6 | 1558 | Scan (In_Tree); |
fbf5a39b AC |
1559 | end loop; |
1560 | ||
5c1c8a03 AC |
1561 | -- See if this is an extending project |
1562 | ||
1563 | if Token = Tok_Extends then | |
1564 | ||
bd0a4cab | 1565 | if Is_Config_File then |
ede007da | 1566 | Error_Msg |
4437a530 | 1567 | (Env.Flags, |
e2d9085b | 1568 | "extending configuration project not allowed", Token_Ptr); |
ede007da VC |
1569 | end if; |
1570 | ||
5c1c8a03 AC |
1571 | -- Make sure that gnatmake will use mapping files |
1572 | ||
a0a786e3 | 1573 | Opt.Create_Mapping_File := True; |
5c1c8a03 AC |
1574 | |
1575 | -- We are extending another project | |
1576 | ||
1577 | Extending := True; | |
1578 | ||
1a5d715a | 1579 | Scan (In_Tree); -- past EXTENDS |
5c1c8a03 AC |
1580 | |
1581 | if Token = Tok_All then | |
1582 | Extends_All := True; | |
7e98a4c6 VC |
1583 | Set_Is_Extending_All (Project, In_Tree); |
1584 | Scan (In_Tree); -- scan past ALL | |
5c1c8a03 AC |
1585 | end if; |
1586 | end if; | |
1587 | ||
fbf5a39b AC |
1588 | -- If the name is well formed, Buffer_Last is > 0 |
1589 | ||
1590 | if Buffer_Last > 0 then | |
1591 | ||
1592 | -- The Buffer contains the name of the project | |
1593 | ||
1594 | Name_Len := Buffer_Last; | |
1595 | Name_Buffer (1 .. Name_Len) := Buffer (1 .. Buffer_Last); | |
1596 | Name_Of_Project := Name_Find; | |
7e98a4c6 | 1597 | Set_Name_Of (Project, In_Tree, Name_Of_Project); |
fbf5a39b AC |
1598 | |
1599 | -- To get expected name of the project file, replace dots by dashes | |
1600 | ||
fbf5a39b AC |
1601 | for Index in 1 .. Name_Len loop |
1602 | if Name_Buffer (Index) = '.' then | |
1603 | Name_Buffer (Index) := '-'; | |
1604 | end if; | |
1605 | end loop; | |
1606 | ||
19235870 RK |
1607 | Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); |
1608 | ||
1609 | declare | |
ede007da VC |
1610 | Expected_Name : constant Name_Id := Name_Find; |
1611 | Extension : String_Access; | |
19235870 RK |
1612 | |
1613 | begin | |
fbf5a39b AC |
1614 | -- Output a warning if the actual name is not the expected name |
1615 | ||
bd0a4cab | 1616 | if not Is_Config_File |
ede007da | 1617 | and then (Name_From_Path /= No_Name) |
19235870 RK |
1618 | and then Expected_Name /= Name_From_Path |
1619 | then | |
ede007da VC |
1620 | Error_Msg_Name_1 := Expected_Name; |
1621 | ||
bd0a4cab | 1622 | if Is_Config_File then |
ede007da VC |
1623 | Extension := new String'(Config_Project_File_Extension); |
1624 | ||
1625 | else | |
1626 | Extension := new String'(Project_File_Extension); | |
1627 | end if; | |
1628 | ||
e2d9085b | 1629 | Error_Msg |
4437a530 | 1630 | (Env.Flags, |
e2d9085b EB |
1631 | "?file name does not match project name, should be `%%" |
1632 | & Extension.all & "`", | |
1633 | Token_Ptr); | |
19235870 RK |
1634 | end if; |
1635 | end; | |
1636 | ||
4528392f AC |
1637 | -- Read the original casing of the project name and put it in the |
1638 | -- project node. | |
c471e2da AC |
1639 | |
1640 | declare | |
67efd80a | 1641 | Loc : Source_Ptr; |
c471e2da | 1642 | begin |
67efd80a | 1643 | Loc := Location_Of (Project, In_Tree); |
c471e2da AC |
1644 | for J in 1 .. Name_Len loop |
1645 | Name_Buffer (J) := Sinput.Source (Loc); | |
1646 | Loc := Loc + 1; | |
1647 | end loop; | |
1648 | ||
4528392f | 1649 | Set_Display_Name_Of (Project, In_Tree, Name_Find); |
c471e2da AC |
1650 | end; |
1651 | ||
fbf5a39b | 1652 | declare |
9596236a | 1653 | From_Ext : Extension_Origin := None; |
fbf5a39b AC |
1654 | |
1655 | begin | |
9596236a AC |
1656 | -- Extending_All is always propagated |
1657 | ||
5c1c8a03 | 1658 | if From_Extended = Extending_All or else Extends_All then |
9596236a AC |
1659 | From_Ext := Extending_All; |
1660 | ||
1661 | -- Otherwise, From_Extended is set to Extending_Single if the | |
1662 | -- current project is an extending project. | |
1663 | ||
1664 | elsif Extended then | |
1665 | From_Ext := Extending_Simple; | |
1666 | end if; | |
1667 | ||
fbf5a39b | 1668 | Post_Parse_Context_Clause |
7e98a4c6 VC |
1669 | (In_Tree => In_Tree, |
1670 | Context_Clause => First_With, | |
07ef182e | 1671 | In_Limited => In_Limited, |
1a5d715a | 1672 | Limited_Withs => False, |
fbf5a39b AC |
1673 | Imported_Projects => Imported_Projects, |
1674 | Project_Directory => Project_Directory, | |
0da2c8ac | 1675 | From_Extended => From_Ext, |
ede007da | 1676 | Packages_To_Check => Packages_To_Check, |
6c1f47ee | 1677 | Depth => Depth + 1, |
bd0a4cab | 1678 | Current_Dir => Current_Dir, |
e2d9085b | 1679 | Is_Config_File => Is_Config_File, |
4437a530 | 1680 | Env => Env); |
7e98a4c6 | 1681 | Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects); |
fbf5a39b AC |
1682 | end; |
1683 | ||
bd0a4cab | 1684 | if not Is_Config_File then |
1b685674 VC |
1685 | declare |
1686 | Name_And_Node : Tree_Private_Part.Project_Name_And_Node := | |
6c1f47ee EB |
1687 | Tree_Private_Part.Projects_Htable.Get_First |
1688 | (In_Tree.Projects_HT); | |
1689 | Project_Name : Name_Id := Name_And_Node.Name; | |
1b685674 VC |
1690 | |
1691 | begin | |
1692 | -- Check if we already have a project with this name | |
1693 | ||
1694 | while Project_Name /= No_Name | |
1695 | and then Project_Name /= Name_Of_Project | |
1696 | loop | |
1697 | Name_And_Node := | |
1698 | Tree_Private_Part.Projects_Htable.Get_Next | |
1699 | (In_Tree.Projects_HT); | |
1700 | Project_Name := Name_And_Node.Name; | |
1701 | end loop; | |
19235870 | 1702 | |
1b685674 | 1703 | -- Report an error if we already have a project with this name |
fbf5a39b | 1704 | |
1b685674 | 1705 | if Project_Name /= No_Name then |
4f469be3 | 1706 | Duplicated := True; |
1b685674 VC |
1707 | Error_Msg_Name_1 := Project_Name; |
1708 | Error_Msg | |
4437a530 | 1709 | (Env.Flags, "duplicate project name %%", |
1b685674 VC |
1710 | Location_Of (Project, In_Tree)); |
1711 | Error_Msg_Name_1 := | |
1712 | Name_Id (Path_Name_Of (Name_And_Node.Node, In_Tree)); | |
1713 | Error_Msg | |
4437a530 EB |
1714 | (Env.Flags, |
1715 | "\already in %%", Location_Of (Project, In_Tree)); | |
1b685674 VC |
1716 | end if; |
1717 | end; | |
1718 | end if; | |
19235870 | 1719 | |
19235870 RK |
1720 | end if; |
1721 | ||
5c1c8a03 | 1722 | if Extending then |
19235870 RK |
1723 | Expect (Tok_String_Literal, "literal string"); |
1724 | ||
1725 | if Token = Tok_String_Literal then | |
39f4e199 | 1726 | Set_Extended_Project_Path_Of |
ede007da VC |
1727 | (Project, |
1728 | In_Tree, | |
1729 | Path_Name_Type (Token_Name)); | |
19235870 RK |
1730 | |
1731 | declare | |
1732 | Original_Path_Name : constant String := | |
fbf5a39b | 1733 | Get_Name_String (Token_Name); |
8d606a78 | 1734 | |
a0a786e3 | 1735 | Extended_Project_Path_Name_Id : Path_Name_Type; |
8d606a78 | 1736 | |
19235870 | 1737 | begin |
a0a786e3 | 1738 | Find_Project |
4437a530 | 1739 | (Env.Project_Path, |
a0a786e3 EB |
1740 | Project_File_Name => Original_Path_Name, |
1741 | Directory => Get_Name_String (Project_Directory), | |
a96ca600 | 1742 | Path => Extended_Project_Path_Name_Id); |
a0a786e3 EB |
1743 | |
1744 | if Extended_Project_Path_Name_Id = No_Path then | |
19235870 | 1745 | |
fbf5a39b | 1746 | -- We could not find the project file to extend |
19235870 | 1747 | |
ede007da VC |
1748 | Error_Msg_Name_1 := Token_Name; |
1749 | ||
4437a530 | 1750 | Error_Msg (Env.Flags, "unknown project file: %%", Token_Ptr); |
19235870 | 1751 | |
8d606a78 | 1752 | -- If not in the main project file, display the import path |
07fc65c4 GB |
1753 | |
1754 | if Project_Stack.Last > 1 then | |
ede007da VC |
1755 | Error_Msg_Name_1 := |
1756 | Name_Id | |
39f4e199 | 1757 | (Project_Stack.Table (Project_Stack.Last).Path_Name); |
4437a530 | 1758 | Error_Msg (Env.Flags, "\extended by %%", Token_Ptr); |
07fc65c4 GB |
1759 | |
1760 | for Index in reverse 1 .. Project_Stack.Last - 1 loop | |
ede007da VC |
1761 | Error_Msg_Name_1 := |
1762 | Name_Id | |
39f4e199 | 1763 | (Project_Stack.Table (Index).Path_Name); |
4437a530 | 1764 | Error_Msg (Env.Flags, "\imported by %%", Token_Ptr); |
07fc65c4 GB |
1765 | end loop; |
1766 | end if; | |
1767 | ||
19235870 | 1768 | else |
9596236a | 1769 | declare |
5c1c8a03 | 1770 | From_Ext : Extension_Origin := None; |
9596236a AC |
1771 | |
1772 | begin | |
5c1c8a03 AC |
1773 | if From_Extended = Extending_All or else Extends_All then |
1774 | From_Ext := Extending_All; | |
9596236a AC |
1775 | end if; |
1776 | ||
1777 | Parse_Single_Project | |
7e98a4c6 VC |
1778 | (In_Tree => In_Tree, |
1779 | Project => Extended_Project, | |
1780 | Extends_All => Extends_All, | |
a0a786e3 | 1781 | Path_Name_Id => Extended_Project_Path_Name_Id, |
7e98a4c6 VC |
1782 | Extended => True, |
1783 | From_Extended => From_Ext, | |
1784 | In_Limited => In_Limited, | |
ede007da | 1785 | Packages_To_Check => Packages_To_Check, |
6c1f47ee | 1786 | Depth => Depth + 1, |
bd0a4cab | 1787 | Current_Dir => Current_Dir, |
e2d9085b | 1788 | Is_Config_File => Is_Config_File, |
4437a530 | 1789 | Env => Env); |
9596236a AC |
1790 | end; |
1791 | ||
4f469be3 VC |
1792 | if Present (Extended_Project) then |
1793 | ||
13f39091 AC |
1794 | if Project_Qualifier_Of (Extended_Project, In_Tree) = |
1795 | Aggregate | |
1796 | then | |
1797 | Error_Msg_Name_1 := | |
1798 | Name_Id (Path_Name_Of (Extended_Project, In_Tree)); | |
1799 | Error_Msg | |
1800 | (Env.Flags, | |
1801 | "cannot extend aggregate project %%", | |
1802 | Location_Of (Project, In_Tree)); | |
1803 | end if; | |
1804 | ||
4f469be3 VC |
1805 | -- A project that extends an extending-all project is |
1806 | -- also an extending-all project. | |
1807 | ||
1808 | if Is_Extending_All (Extended_Project, In_Tree) then | |
1809 | Set_Is_Extending_All (Project, In_Tree); | |
1810 | end if; | |
1811 | ||
1812 | -- An abstract project can only extend an abstract | |
8d606a78 RD |
1813 | -- project. Otherwise we may have an abstract project |
1814 | -- with sources if it inherits sources from the project | |
4f469be3 | 1815 | -- it extends. |
9596236a | 1816 | |
7ed57189 AC |
1817 | if Project_Qualifier_Of (Project, In_Tree) = |
1818 | Abstract_Project | |
1819 | and then | |
1820 | Project_Qualifier_Of (Extended_Project, In_Tree) /= | |
1821 | Abstract_Project | |
4f469be3 VC |
1822 | then |
1823 | Error_Msg | |
4437a530 | 1824 | (Env.Flags, "an abstract project can only extend " & |
4f469be3 VC |
1825 | "another abstract project", |
1826 | Qualifier_Location); | |
1827 | end if; | |
9596236a | 1828 | end if; |
19235870 RK |
1829 | end if; |
1830 | end; | |
1831 | ||
1a5d715a | 1832 | Scan (In_Tree); -- past the extended project path |
19235870 RK |
1833 | end if; |
1834 | end if; | |
1835 | ||
4437a530 EB |
1836 | Check_Extending_All_Imports (Env.Flags, In_Tree, Project); |
1837 | Check_Aggregate_Imports (Env.Flags, In_Tree, Project); | |
88de755d | 1838 | Check_Import_Aggregate (Env.Flags, In_Tree, Project); |
9596236a | 1839 | |
fbf5a39b AC |
1840 | -- Check that a project with a name including a dot either imports |
1841 | -- or extends the project whose name precedes the last dot. | |
1842 | ||
1843 | if Name_Of_Project /= No_Name then | |
1844 | Get_Name_String (Name_Of_Project); | |
1845 | ||
1846 | else | |
1847 | Name_Len := 0; | |
1848 | end if; | |
1849 | ||
1850 | -- Look for the last dot | |
1851 | ||
1852 | while Name_Len > 0 and then Name_Buffer (Name_Len) /= '.' loop | |
1853 | Name_Len := Name_Len - 1; | |
1854 | end loop; | |
1855 | ||
3ce5ca75 | 1856 | -- If a dot was found, check if parent project is imported or extended |
fbf5a39b AC |
1857 | |
1858 | if Name_Len > 0 then | |
1859 | Name_Len := Name_Len - 1; | |
1860 | ||
1861 | declare | |
3ce5ca75 RD |
1862 | Parent_Name : constant Name_Id := Name_Find; |
1863 | Parent_Found : Boolean := False; | |
1864 | Parent_Node : Project_Node_Id := Empty_Node; | |
1865 | With_Clause : Project_Node_Id := | |
1866 | First_With_Clause_Of (Project, In_Tree); | |
1c218ac3 | 1867 | Imp_Proj_Name : Name_Id; |
fbf5a39b AC |
1868 | |
1869 | begin | |
1870 | -- If there is an extended project, check its name | |
1871 | ||
4f469be3 VC |
1872 | if Present (Extended_Project) then |
1873 | Parent_Node := Extended_Project; | |
7e98a4c6 | 1874 | Parent_Found := |
ede007da | 1875 | Name_Of (Extended_Project, In_Tree) = Parent_Name; |
fbf5a39b AC |
1876 | end if; |
1877 | ||
1878 | -- If the parent project is not the extended project, | |
1879 | -- check each imported project until we find the parent project. | |
1880 | ||
1c218ac3 | 1881 | Imported_Loop : |
4f469be3 VC |
1882 | while not Parent_Found and then Present (With_Clause) loop |
1883 | Parent_Node := Project_Node_Of (With_Clause, In_Tree); | |
3ce5ca75 | 1884 | Extension_Loop : while Present (Parent_Node) loop |
1c218ac3 AC |
1885 | Imp_Proj_Name := Name_Of (Parent_Node, In_Tree); |
1886 | Parent_Found := Imp_Proj_Name = Parent_Name; | |
1887 | exit Imported_Loop when Parent_Found; | |
1888 | Parent_Node := | |
1889 | Extended_Project_Of | |
1890 | (Project_Declaration_Of (Parent_Node, In_Tree), | |
1891 | In_Tree); | |
1892 | end loop Extension_Loop; | |
1893 | ||
7e98a4c6 | 1894 | With_Clause := Next_With_Clause_Of (With_Clause, In_Tree); |
1c218ac3 | 1895 | end loop Imported_Loop; |
fbf5a39b | 1896 | |
4f469be3 VC |
1897 | if Parent_Found then |
1898 | Set_Parent_Project_Of (Project, In_Tree, To => Parent_Node); | |
1899 | ||
1900 | else | |
1901 | -- If the parent project was not found, report an error | |
fbf5a39b | 1902 | |
fbf5a39b | 1903 | Error_Msg_Name_1 := Name_Of_Project; |
ede007da | 1904 | Error_Msg_Name_2 := Parent_Name; |
4437a530 | 1905 | Error_Msg (Env.Flags, |
e2d9085b | 1906 | "project %% does not import or extend project %%", |
7e98a4c6 | 1907 | Location_Of (Project, In_Tree)); |
fbf5a39b AC |
1908 | end if; |
1909 | end; | |
1910 | end if; | |
1911 | ||
1912 | Expect (Tok_Is, "IS"); | |
c45b6ae0 AC |
1913 | Set_End_Of_Line (Project); |
1914 | Set_Previous_Line_Node (Project); | |
1915 | Set_Next_End_Node (Project); | |
19235870 RK |
1916 | |
1917 | declare | |
1918 | Project_Declaration : Project_Node_Id := Empty_Node; | |
1919 | ||
1920 | begin | |
44e1918a | 1921 | -- No need to Scan past "is", Prj.Dect.Parse will do it |
19235870 RK |
1922 | |
1923 | Prj.Dect.Parse | |
7e98a4c6 VC |
1924 | (In_Tree => In_Tree, |
1925 | Declarations => Project_Declaration, | |
1926 | Current_Project => Project, | |
1927 | Extends => Extended_Project, | |
bd0a4cab | 1928 | Packages_To_Check => Packages_To_Check, |
e2d9085b | 1929 | Is_Config_File => Is_Config_File, |
4437a530 | 1930 | Flags => Env.Flags); |
7e98a4c6 | 1931 | Set_Project_Declaration_Of (Project, In_Tree, Project_Declaration); |
fbf5a39b | 1932 | |
4f469be3 | 1933 | if Present (Extended_Project) |
7ed57189 AC |
1934 | and then Project_Qualifier_Of (Extended_Project, In_Tree) /= |
1935 | Abstract_Project | |
4f469be3 | 1936 | then |
fbf5a39b | 1937 | Set_Extending_Project_Of |
7e98a4c6 VC |
1938 | (Project_Declaration_Of (Extended_Project, In_Tree), In_Tree, |
1939 | To => Project); | |
fbf5a39b | 1940 | end if; |
19235870 RK |
1941 | end; |
1942 | ||
fbf5a39b | 1943 | Expect (Tok_End, "END"); |
c45b6ae0 | 1944 | Remove_Next_End_Node; |
19235870 | 1945 | |
fbf5a39b | 1946 | -- Skip "end" if present |
19235870 RK |
1947 | |
1948 | if Token = Tok_End then | |
7e98a4c6 | 1949 | Scan (In_Tree); |
19235870 RK |
1950 | end if; |
1951 | ||
fbf5a39b AC |
1952 | -- Clear the Buffer |
1953 | ||
1954 | Buffer_Last := 0; | |
19235870 | 1955 | |
fbf5a39b AC |
1956 | -- Store the name following "end" in the Buffer. The name may be made of |
1957 | -- several simple names. | |
19235870 | 1958 | |
fbf5a39b AC |
1959 | loop |
1960 | Expect (Tok_Identifier, "identifier"); | |
1961 | ||
1962 | -- If we don't have an identifier, clear the buffer before exiting to | |
1963 | -- avoid checking the name. | |
1964 | ||
1965 | if Token /= Tok_Identifier then | |
1966 | Buffer_Last := 0; | |
1967 | exit; | |
1968 | end if; | |
1969 | ||
1970 | -- Add the identifier to the Buffer | |
1971 | Get_Name_String (Token_Name); | |
7e98a4c6 | 1972 | Add_To_Buffer (Name_Buffer (1 .. Name_Len), Buffer, Buffer_Last); |
fbf5a39b AC |
1973 | |
1974 | -- Scan past the identifier | |
19235870 | 1975 | |
7e98a4c6 | 1976 | Scan (In_Tree); |
fbf5a39b | 1977 | exit when Token /= Tok_Dot; |
7e98a4c6 VC |
1978 | Add_To_Buffer (".", Buffer, Buffer_Last); |
1979 | Scan (In_Tree); | |
fbf5a39b AC |
1980 | end loop; |
1981 | ||
1982 | -- If we have a valid name, check if it is the name of the project | |
1983 | ||
1984 | if Name_Of_Project /= No_Name and then Buffer_Last > 0 then | |
1985 | if To_Lower (Buffer (1 .. Buffer_Last)) /= | |
7e98a4c6 | 1986 | Get_Name_String (Name_Of (Project, In_Tree)) |
19235870 | 1987 | then |
fbf5a39b AC |
1988 | -- Invalid name: report an error |
1989 | ||
4437a530 | 1990 | Error_Msg (Env.Flags, "expected """ & |
7e98a4c6 | 1991 | Get_Name_String (Name_Of (Project, In_Tree)) & """", |
19235870 RK |
1992 | Token_Ptr); |
1993 | end if; | |
1994 | end if; | |
1995 | ||
fbf5a39b AC |
1996 | Expect (Tok_Semicolon, "`;`"); |
1997 | ||
1998 | -- Check that there is no more text following the end of the project | |
1999 | -- source. | |
2000 | ||
2001 | if Token = Tok_Semicolon then | |
c45b6ae0 | 2002 | Set_Previous_End_Node (Project); |
7e98a4c6 | 2003 | Scan (In_Tree); |
19235870 | 2004 | |
fbf5a39b AC |
2005 | if Token /= Tok_EOF then |
2006 | Error_Msg | |
4437a530 EB |
2007 | (Env.Flags, |
2008 | "unexpected text following end of project", Token_Ptr); | |
fbf5a39b AC |
2009 | end if; |
2010 | end if; | |
19235870 | 2011 | |
4f469be3 VC |
2012 | if not Duplicated and then Name_Of_Project /= No_Name then |
2013 | ||
2014 | -- Add the name of the project to the hash table, so that we can | |
2015 | -- check that no other subsequent project will have the same name. | |
2016 | ||
2017 | Tree_Private_Part.Projects_Htable.Set | |
2018 | (T => In_Tree.Projects_HT, | |
2019 | K => Name_Of_Project, | |
2020 | E => (Name => Name_Of_Project, | |
2021 | Node => Project, | |
13f39091 | 2022 | Resolved_Path => Resolved_Path_Name, |
4f469be3 | 2023 | Extended => Extended, |
579847c2 | 2024 | From_Extended => From_Extended /= None, |
9d9f5f49 | 2025 | Proj_Qualifier => Project_Qualifier_Of (Project, In_Tree))); |
4f469be3 VC |
2026 | end if; |
2027 | ||
1a5d715a VC |
2028 | declare |
2029 | From_Ext : Extension_Origin := None; | |
2030 | ||
2031 | begin | |
2032 | -- Extending_All is always propagated | |
2033 | ||
2034 | if From_Extended = Extending_All or else Extends_All then | |
2035 | From_Ext := Extending_All; | |
2036 | ||
2037 | -- Otherwise, From_Extended is set to Extending_Single if the | |
2038 | -- current project is an extending project. | |
2039 | ||
2040 | elsif Extended then | |
2041 | From_Ext := Extending_Simple; | |
2042 | end if; | |
2043 | ||
2044 | Post_Parse_Context_Clause | |
2045 | (In_Tree => In_Tree, | |
2046 | Context_Clause => First_With, | |
07ef182e | 2047 | In_Limited => In_Limited, |
1a5d715a VC |
2048 | Limited_Withs => True, |
2049 | Imported_Projects => Imported_Projects, | |
2050 | Project_Directory => Project_Directory, | |
2051 | From_Extended => From_Ext, | |
1a5d715a VC |
2052 | Packages_To_Check => Packages_To_Check, |
2053 | Depth => Depth + 1, | |
bd0a4cab | 2054 | Current_Dir => Current_Dir, |
e2d9085b | 2055 | Is_Config_File => Is_Config_File, |
4437a530 | 2056 | Env => Env); |
1a5d715a VC |
2057 | Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects); |
2058 | end; | |
2059 | ||
19235870 RK |
2060 | -- Restore the scan state, in case we are not the main project |
2061 | ||
2062 | Restore_Project_Scan_State (Project_Scan_State); | |
2063 | ||
fbf5a39b AC |
2064 | -- And remove the project from the project stack |
2065 | ||
19235870 | 2066 | Project_Stack.Decrement_Last; |
c45b6ae0 AC |
2067 | |
2068 | -- Indicate if there are unkept comments | |
2069 | ||
2070 | Tree.Set_Project_File_Includes_Unkept_Comments | |
7e98a4c6 VC |
2071 | (Node => Project, |
2072 | In_Tree => In_Tree, | |
2073 | To => Tree.There_Are_Unkept_Comments); | |
c45b6ae0 AC |
2074 | |
2075 | -- And restore the comment state that was saved | |
2076 | ||
443614e3 | 2077 | Tree.Restore_And_Free (Project_Comment_State); |
3e582869 | 2078 | |
c4d67e2d | 2079 | Debug_Decrease_Indent; |
9d5598bf AC |
2080 | |
2081 | if Project /= Empty_Node and then Implicit_Project then | |
2082 | Name_Len := 0; | |
2083 | Add_Str_To_Name_Buffer (Current_Dir); | |
2084 | Add_Char_To_Name_Buffer (Dir_Sep); | |
2085 | In_Tree.Project_Nodes.Table (Project).Directory := Name_Find; | |
2086 | end if; | |
19235870 RK |
2087 | end Parse_Single_Project; |
2088 | ||
19235870 RK |
2089 | ----------------------- |
2090 | -- Project_Name_From -- | |
2091 | ----------------------- | |
2092 | ||
bd0a4cab EB |
2093 | function Project_Name_From |
2094 | (Path_Name : String; | |
2095 | Is_Config_File : Boolean) return Name_Id | |
2096 | is | |
19235870 | 2097 | Canonical : String (1 .. Path_Name'Length) := Path_Name; |
6c1f47ee EB |
2098 | First : Natural := Canonical'Last; |
2099 | Last : Natural := First; | |
2100 | Index : Positive; | |
19235870 RK |
2101 | |
2102 | begin | |
fbf5a39b | 2103 | if Current_Verbosity = High then |
3e582869 | 2104 | Debug_Output ("Project_Name_From (""" & Canonical & """)"); |
fbf5a39b AC |
2105 | end if; |
2106 | ||
2107 | -- If the path name is empty, return No_Name to indicate failure | |
2108 | ||
19235870 | 2109 | if First = 0 then |
ede007da | 2110 | return No_Name; |
19235870 RK |
2111 | end if; |
2112 | ||
2113 | Canonical_Case_File_Name (Canonical); | |
2114 | ||
fbf5a39b AC |
2115 | -- Look for the last dot in the path name |
2116 | ||
19235870 RK |
2117 | while First > 0 |
2118 | and then | |
2119 | Canonical (First) /= '.' | |
2120 | loop | |
2121 | First := First - 1; | |
2122 | end loop; | |
2123 | ||
fbf5a39b AC |
2124 | -- If we have a dot, check that it is followed by the correct extension |
2125 | ||
2126 | if First > 0 and then Canonical (First) = '.' then | |
bd0a4cab | 2127 | if (not Is_Config_File |
4f469be3 VC |
2128 | and then Canonical (First .. Last) = Project_File_Extension |
2129 | and then First /= 1) | |
2130 | or else | |
bd0a4cab | 2131 | (Is_Config_File |
4f469be3 VC |
2132 | and then |
2133 | Canonical (First .. Last) = Config_Project_File_Extension | |
2134 | and then First /= 1) | |
19235870 | 2135 | then |
fbf5a39b AC |
2136 | -- Look for the last directory separator, if any |
2137 | ||
19235870 RK |
2138 | First := First - 1; |
2139 | Last := First; | |
19235870 RK |
2140 | while First > 0 |
2141 | and then Canonical (First) /= '/' | |
2142 | and then Canonical (First) /= Dir_Sep | |
2143 | loop | |
2144 | First := First - 1; | |
2145 | end loop; | |
2146 | ||
2147 | else | |
fbf5a39b AC |
2148 | -- Not the correct extension, return No_Name to indicate failure |
2149 | ||
ede007da | 2150 | return No_Name; |
19235870 RK |
2151 | end if; |
2152 | ||
fbf5a39b AC |
2153 | -- If no dot in the path name, return No_Name to indicate failure |
2154 | ||
19235870 | 2155 | else |
ede007da | 2156 | return No_Name; |
19235870 RK |
2157 | end if; |
2158 | ||
fbf5a39b AC |
2159 | First := First + 1; |
2160 | ||
2161 | -- If the extension is the file name, return No_Name to indicate failure | |
2162 | ||
2163 | if First > Last then | |
ede007da | 2164 | return No_Name; |
19235870 RK |
2165 | end if; |
2166 | ||
fbf5a39b AC |
2167 | -- Put the name in lower case into Name_Buffer |
2168 | ||
19235870 RK |
2169 | Name_Len := Last - First + 1; |
2170 | Name_Buffer (1 .. Name_Len) := To_Lower (Canonical (First .. Last)); | |
2171 | ||
fbf5a39b | 2172 | Index := 1; |
19235870 | 2173 | |
fbf5a39b AC |
2174 | -- Check if it is a well formed project name. Return No_Name if it is |
2175 | -- ill formed. | |
2176 | ||
2177 | loop | |
2178 | if not Is_Letter (Name_Buffer (Index)) then | |
ede007da | 2179 | return No_Name; |
fbf5a39b AC |
2180 | |
2181 | else | |
2182 | loop | |
2183 | Index := Index + 1; | |
2184 | ||
2185 | exit when Index >= Name_Len; | |
2186 | ||
2187 | if Name_Buffer (Index) = '_' then | |
2188 | if Name_Buffer (Index + 1) = '_' then | |
ede007da | 2189 | return No_Name; |
fbf5a39b AC |
2190 | end if; |
2191 | end if; | |
2192 | ||
2193 | exit when Name_Buffer (Index) = '-'; | |
2194 | ||
2195 | if Name_Buffer (Index) /= '_' | |
2196 | and then not Is_Alphanumeric (Name_Buffer (Index)) | |
2197 | then | |
ede007da | 2198 | return No_Name; |
19235870 RK |
2199 | end if; |
2200 | ||
fbf5a39b AC |
2201 | end loop; |
2202 | end if; | |
19235870 | 2203 | |
fbf5a39b AC |
2204 | if Index >= Name_Len then |
2205 | if Is_Alphanumeric (Name_Buffer (Name_Len)) then | |
19235870 | 2206 | |
fbf5a39b | 2207 | -- All checks have succeeded. Return name in Name_Buffer |
19235870 | 2208 | |
fbf5a39b | 2209 | return Name_Find; |
19235870 | 2210 | |
fbf5a39b | 2211 | else |
ede007da | 2212 | return No_Name; |
fbf5a39b AC |
2213 | end if; |
2214 | ||
2215 | elsif Name_Buffer (Index) = '-' then | |
2216 | Index := Index + 1; | |
2217 | end if; | |
2218 | end loop; | |
19235870 RK |
2219 | end Project_Name_From; |
2220 | ||
19235870 | 2221 | end Prj.Part; |