]>
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 | -- -- | |
68e2ea27 | 9 | -- Copyright (C) 2001-2006, 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- -- | |
13 | -- ware Foundation; either version 2, or (at your option) any later ver- -- | |
14 | -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- | |
15 | -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- | |
16 | -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- | |
17 | -- for more details. You should have received a copy of the GNU General -- | |
18 | -- Public License distributed with GNAT; see file COPYING. If not, write -- | |
cb5fee25 KC |
19 | -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, -- |
20 | -- Boston, MA 02110-1301, USA. -- | |
19235870 RK |
21 | -- -- |
22 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
71ff80dc | 23 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
19235870 RK |
24 | -- -- |
25 | ------------------------------------------------------------------------------ | |
26 | ||
fbf5a39b AC |
27 | with Err_Vars; use Err_Vars; |
28 | with Namet; use Namet; | |
b7e429ab | 29 | with Opt; use Opt; |
fbf5a39b AC |
30 | with Osint; use Osint; |
31 | with Output; use Output; | |
32 | with Prj.Com; use Prj.Com; | |
33 | with Prj.Dect; | |
34 | with Prj.Err; use Prj.Err; | |
44e1918a | 35 | with Prj.Ext; use Prj.Ext; |
fbf5a39b AC |
36 | with Sinput; use Sinput; |
37 | with Sinput.P; use Sinput.P; | |
9596236a | 38 | with Snames; |
fbf5a39b | 39 | with Table; |
fbf5a39b | 40 | |
19235870 RK |
41 | with Ada.Characters.Handling; use Ada.Characters.Handling; |
42 | with Ada.Exceptions; use Ada.Exceptions; | |
fbf5a39b | 43 | |
19235870 | 44 | with GNAT.Directory_Operations; use GNAT.Directory_Operations; |
19235870 | 45 | |
9596236a AC |
46 | with System.HTable; use System.HTable; |
47 | ||
19235870 RK |
48 | package body Prj.Part is |
49 | ||
7e98a4c6 VC |
50 | Buffer : String_Access; |
51 | Buffer_Last : Natural := 0; | |
52 | ||
19235870 RK |
53 | Dir_Sep : Character renames GNAT.OS_Lib.Directory_Separator; |
54 | ||
9596236a AC |
55 | type Extension_Origin is (None, Extending_Simple, Extending_All); |
56 | -- Type of parameter From_Extended for procedures Parse_Single_Project and | |
57 | -- Post_Parse_Context_Clause. Extending_All means that we are parsing the | |
58 | -- tree rooted at an extending all project. | |
59 | ||
19235870 RK |
60 | ------------------------------------ |
61 | -- Local Packages and Subprograms -- | |
62 | ------------------------------------ | |
63 | ||
fbf5a39b AC |
64 | type With_Id is new Nat; |
65 | No_With : constant With_Id := 0; | |
66 | ||
67 | type With_Record is record | |
68 | Path : Name_Id; | |
69 | Location : Source_Ptr; | |
70 | Limited_With : Boolean; | |
c45b6ae0 | 71 | Node : Project_Node_Id; |
fbf5a39b AC |
72 | Next : With_Id; |
73 | end record; | |
74 | -- Information about an imported project, to be put in table Withs below | |
75 | ||
76 | package Withs is new Table.Table | |
77 | (Table_Component_Type => With_Record, | |
78 | Table_Index_Type => With_Id, | |
79 | Table_Low_Bound => 1, | |
80 | Table_Initial => 10, | |
81 | Table_Increment => 50, | |
82 | Table_Name => "Prj.Part.Withs"); | |
83 | -- Table used to store temporarily paths and locations of imported | |
84 | -- projects. These imported projects will be effectively parsed after the | |
85 | -- name of the current project has been extablished. | |
86 | ||
6871ba5f AC |
87 | type Names_And_Id is record |
88 | Path_Name : Name_Id; | |
89 | Canonical_Path_Name : Name_Id; | |
8a7988f5 | 90 | Id : Project_Node_Id; |
fbf5a39b AC |
91 | end record; |
92 | ||
19235870 | 93 | package Project_Stack is new Table.Table |
6871ba5f | 94 | (Table_Component_Type => Names_And_Id, |
19235870 RK |
95 | Table_Index_Type => Nat, |
96 | Table_Low_Bound => 1, | |
97 | Table_Initial => 10, | |
fbf5a39b | 98 | Table_Increment => 50, |
19235870 RK |
99 | Table_Name => "Prj.Part.Project_Stack"); |
100 | -- This table is used to detect circular dependencies | |
fbf5a39b AC |
101 | -- for imported and extended projects and to get the project ids of |
102 | -- limited imported projects when there is a circularity with at least | |
103 | -- one limited imported project file. | |
104 | ||
7e98a4c6 | 105 | package Virtual_Hash is new System.HTable.Simple_HTable |
9596236a AC |
106 | (Header_Num => Header_Num, |
107 | Element => Project_Node_Id, | |
108 | No_Element => Empty_Node, | |
109 | Key => Project_Node_Id, | |
110 | Hash => Prj.Tree.Hash, | |
111 | Equal => "="); | |
112 | -- Hash table to store the node id of the project for which a virtual | |
113 | -- extending project need to be created. | |
114 | ||
7e98a4c6 | 115 | package Processed_Hash is new System.HTable.Simple_HTable |
9596236a AC |
116 | (Header_Num => Header_Num, |
117 | Element => Boolean, | |
118 | No_Element => False, | |
119 | Key => Project_Node_Id, | |
120 | Hash => Prj.Tree.Hash, | |
121 | Equal => "="); | |
122 | -- Hash table to store the project process when looking for project that | |
123 | -- need to have a virtual extending project, to avoid processing the same | |
124 | -- project twice. | |
125 | ||
126 | procedure Create_Virtual_Extending_Project | |
127 | (For_Project : Project_Node_Id; | |
7e98a4c6 VC |
128 | Main_Project : Project_Node_Id; |
129 | In_Tree : Project_Node_Tree_Ref); | |
9596236a AC |
130 | -- Create a virtual extending project of For_Project. Main_Project is |
131 | -- the extending all project. | |
9cd6ae61 VC |
132 | -- |
133 | -- The String_Value_Of is not set for the automatically added with | |
134 | -- clause and keeps the default value of No_Name. This enables Prj.PP | |
135 | -- to skip these automatically added with clauses to be processed. | |
9596236a AC |
136 | |
137 | procedure Look_For_Virtual_Projects_For | |
138 | (Proj : Project_Node_Id; | |
7e98a4c6 | 139 | In_Tree : Project_Node_Tree_Ref; |
9596236a AC |
140 | Potentially_Virtual : Boolean); |
141 | -- Look for projects that need to have a virtual extending project. | |
142 | -- This procedure is recursive. If called with Potentially_Virtual set to | |
143 | -- True, then Proj may need an virtual extending project; otherwise it | |
144 | -- does not (because it is already extended), but other projects that it | |
145 | -- imports may need to be virtually extended. | |
146 | ||
7e98a4c6 VC |
147 | procedure Pre_Parse_Context_Clause |
148 | (In_Tree : Project_Node_Tree_Ref; | |
149 | Context_Clause : out With_Id); | |
fbf5a39b AC |
150 | -- Parse the context clause of a project. |
151 | -- Store the paths and locations of the imported projects in table Withs. | |
152 | -- Does nothing if there is no context clause (if the current | |
153 | -- token is not "with" or "limited" followed by "with"). | |
154 | ||
155 | procedure Post_Parse_Context_Clause | |
156 | (Context_Clause : With_Id; | |
7e98a4c6 | 157 | In_Tree : Project_Node_Tree_Ref; |
fbf5a39b AC |
158 | Imported_Projects : out Project_Node_Id; |
159 | Project_Directory : Name_Id; | |
0da2c8ac | 160 | From_Extended : Extension_Origin; |
7e98a4c6 VC |
161 | In_Limited : Boolean; |
162 | Packages_To_Check : String_List_Access); | |
fbf5a39b AC |
163 | -- Parse the imported projects that have been stored in table Withs, |
164 | -- if any. From_Extended is used for the call to Parse_Single_Project | |
0da2c8ac AC |
165 | -- below. When In_Limited is True, the importing path includes at least |
166 | -- one "limited with". | |
19235870 RK |
167 | |
168 | procedure Parse_Single_Project | |
7e98a4c6 VC |
169 | (In_Tree : Project_Node_Tree_Ref; |
170 | Project : out Project_Node_Id; | |
171 | Extends_All : out Boolean; | |
172 | Path_Name : String; | |
173 | Extended : Boolean; | |
174 | From_Extended : Extension_Origin; | |
175 | In_Limited : Boolean; | |
176 | Packages_To_Check : String_List_Access); | |
19235870 | 177 | -- Parse a project file. |
fbf5a39b | 178 | -- Recursive procedure: it calls itself for imported and extended |
9596236a | 179 | -- projects. When From_Extended is not None, if the project has already |
fbf5a39b | 180 | -- been parsed and is an extended project A, return the ultimate |
0da2c8ac AC |
181 | -- (not extended) project that extends A. When In_Limited is True, |
182 | -- the importing path includes at least one "limited with". | |
19235870 | 183 | |
19235870 RK |
184 | function Project_Path_Name_Of |
185 | (Project_File_Name : String; | |
2820d220 | 186 | Directory : String) return String; |
fbf5a39b AC |
187 | -- Returns the path name of a project file. Returns an empty string |
188 | -- if project file cannot be found. | |
19235870 RK |
189 | |
190 | function Immediate_Directory_Of (Path_Name : Name_Id) return Name_Id; | |
191 | -- Get the directory of the file with the specified path name. | |
192 | -- This includes the directory separator as the last character. | |
193 | -- Returns "./" if Path_Name contains no directory separator. | |
194 | ||
19235870 RK |
195 | function Project_Name_From (Path_Name : String) return Name_Id; |
196 | -- Returns the name of the project that corresponds to its path name. | |
197 | -- Returns No_Name if the path name is invalid, because the corresponding | |
198 | -- project name does not have the syntax of an ada identifier. | |
199 | ||
9596236a AC |
200 | -------------------------------------- |
201 | -- Create_Virtual_Extending_Project -- | |
202 | -------------------------------------- | |
203 | ||
204 | procedure Create_Virtual_Extending_Project | |
205 | (For_Project : Project_Node_Id; | |
7e98a4c6 VC |
206 | Main_Project : Project_Node_Id; |
207 | In_Tree : Project_Node_Tree_Ref) | |
9596236a AC |
208 | is |
209 | ||
210 | Virtual_Name : constant String := | |
211 | Virtual_Prefix & | |
7e98a4c6 | 212 | Get_Name_String (Name_Of (For_Project, In_Tree)); |
9596236a AC |
213 | -- The name of the virtual extending project |
214 | ||
215 | Virtual_Name_Id : Name_Id; | |
216 | -- Virtual extending project name id | |
217 | ||
218 | Virtual_Path_Id : Name_Id; | |
219 | -- Fake path name of the virtual extending project. The directory is | |
220 | -- the same directory as the extending all project. | |
221 | ||
222 | Virtual_Dir_Id : constant Name_Id := | |
7e98a4c6 | 223 | Immediate_Directory_Of (Path_Name_Of (Main_Project, In_Tree)); |
9596236a AC |
224 | -- The directory of the extending all project |
225 | ||
226 | -- The source of the virtual extending project is something like: | |
227 | ||
228 | -- project V$<project name> extends <project path> is | |
229 | ||
230 | -- for Source_Dirs use (); | |
231 | ||
232 | -- end V$<project name>; | |
233 | ||
234 | -- The project directory cannot be specified during parsing; it will be | |
235 | -- put directly in the virtual extending project data during processing. | |
236 | ||
237 | -- Nodes that made up the virtual extending project | |
238 | ||
239 | Virtual_Project : constant Project_Node_Id := | |
7e98a4c6 VC |
240 | Default_Project_Node |
241 | (In_Tree, N_Project); | |
9596236a | 242 | With_Clause : constant Project_Node_Id := |
7e98a4c6 VC |
243 | Default_Project_Node |
244 | (In_Tree, N_With_Clause); | |
9596236a | 245 | Project_Declaration : constant Project_Node_Id := |
7e98a4c6 VC |
246 | Default_Project_Node |
247 | (In_Tree, N_Project_Declaration); | |
9596236a | 248 | Source_Dirs_Declaration : constant Project_Node_Id := |
7e98a4c6 VC |
249 | Default_Project_Node |
250 | (In_Tree, N_Declarative_Item); | |
9596236a AC |
251 | Source_Dirs_Attribute : constant Project_Node_Id := |
252 | Default_Project_Node | |
7e98a4c6 | 253 | (In_Tree, N_Attribute_Declaration, List); |
9596236a | 254 | Source_Dirs_Expression : constant Project_Node_Id := |
7e98a4c6 VC |
255 | Default_Project_Node |
256 | (In_Tree, N_Expression, List); | |
9596236a | 257 | Source_Dirs_Term : constant Project_Node_Id := |
7e98a4c6 VC |
258 | Default_Project_Node |
259 | (In_Tree, N_Term, List); | |
9596236a AC |
260 | Source_Dirs_List : constant Project_Node_Id := |
261 | Default_Project_Node | |
7e98a4c6 | 262 | (In_Tree, N_Literal_String_List, List); |
9596236a AC |
263 | |
264 | begin | |
265 | -- Get the virtual name id | |
266 | ||
267 | Name_Len := Virtual_Name'Length; | |
268 | Name_Buffer (1 .. Name_Len) := Virtual_Name; | |
269 | Virtual_Name_Id := Name_Find; | |
270 | ||
271 | -- Get the virtual path name | |
272 | ||
7e98a4c6 | 273 | Get_Name_String (Path_Name_Of (Main_Project, In_Tree)); |
9596236a AC |
274 | |
275 | while Name_Len > 0 | |
276 | and then Name_Buffer (Name_Len) /= Directory_Separator | |
277 | and then Name_Buffer (Name_Len) /= '/' | |
278 | loop | |
279 | Name_Len := Name_Len - 1; | |
280 | end loop; | |
281 | ||
282 | Name_Buffer (Name_Len + 1 .. Name_Len + Virtual_Name'Length) := | |
283 | Virtual_Name; | |
284 | Name_Len := Name_Len + Virtual_Name'Length; | |
285 | Virtual_Path_Id := Name_Find; | |
286 | ||
287 | -- With clause | |
288 | ||
7e98a4c6 VC |
289 | Set_Name_Of (With_Clause, In_Tree, Virtual_Name_Id); |
290 | Set_Path_Name_Of (With_Clause, In_Tree, Virtual_Path_Id); | |
291 | Set_Project_Node_Of (With_Clause, In_Tree, Virtual_Project); | |
9596236a | 292 | Set_Next_With_Clause_Of |
7e98a4c6 VC |
293 | (With_Clause, In_Tree, First_With_Clause_Of (Main_Project, In_Tree)); |
294 | Set_First_With_Clause_Of (Main_Project, In_Tree, With_Clause); | |
9596236a AC |
295 | |
296 | -- Virtual project node | |
297 | ||
7e98a4c6 VC |
298 | Set_Name_Of (Virtual_Project, In_Tree, Virtual_Name_Id); |
299 | Set_Path_Name_Of (Virtual_Project, In_Tree, Virtual_Path_Id); | |
300 | Set_Location_Of | |
301 | (Virtual_Project, In_Tree, Location_Of (Main_Project, In_Tree)); | |
302 | Set_Directory_Of (Virtual_Project, In_Tree, Virtual_Dir_Id); | |
303 | Set_Project_Declaration_Of | |
304 | (Virtual_Project, In_Tree, Project_Declaration); | |
9596236a | 305 | Set_Extended_Project_Path_Of |
7e98a4c6 | 306 | (Virtual_Project, In_Tree, Path_Name_Of (For_Project, In_Tree)); |
9596236a AC |
307 | |
308 | -- Project declaration | |
309 | ||
310 | Set_First_Declarative_Item_Of | |
7e98a4c6 VC |
311 | (Project_Declaration, In_Tree, Source_Dirs_Declaration); |
312 | Set_Extended_Project_Of (Project_Declaration, In_Tree, For_Project); | |
9596236a AC |
313 | |
314 | -- Source_Dirs declaration | |
315 | ||
7e98a4c6 VC |
316 | Set_Current_Item_Node |
317 | (Source_Dirs_Declaration, In_Tree, Source_Dirs_Attribute); | |
9596236a AC |
318 | |
319 | -- Source_Dirs attribute | |
320 | ||
7e98a4c6 VC |
321 | Set_Name_Of (Source_Dirs_Attribute, In_Tree, Snames.Name_Source_Dirs); |
322 | Set_Expression_Of | |
323 | (Source_Dirs_Attribute, In_Tree, Source_Dirs_Expression); | |
9596236a AC |
324 | |
325 | -- Source_Dirs expression | |
326 | ||
7e98a4c6 | 327 | Set_First_Term (Source_Dirs_Expression, In_Tree, Source_Dirs_Term); |
9596236a AC |
328 | |
329 | -- Source_Dirs term | |
330 | ||
7e98a4c6 | 331 | Set_Current_Term (Source_Dirs_Term, In_Tree, Source_Dirs_List); |
9596236a AC |
332 | |
333 | -- Source_Dirs empty list: nothing to do | |
334 | ||
9cd6ae61 VC |
335 | -- Put virtual project into Projects_Htable |
336 | ||
337 | Prj.Tree.Tree_Private_Part.Projects_Htable.Set | |
338 | (T => In_Tree.Projects_HT, | |
339 | K => Virtual_Name_Id, | |
340 | E => (Name => Virtual_Name_Id, | |
341 | Node => Virtual_Project, | |
342 | Canonical_Path => No_Name, | |
343 | Extended => False)); | |
9596236a AC |
344 | end Create_Virtual_Extending_Project; |
345 | ||
19235870 RK |
346 | ---------------------------- |
347 | -- Immediate_Directory_Of -- | |
348 | ---------------------------- | |
349 | ||
350 | function Immediate_Directory_Of (Path_Name : Name_Id) return Name_Id is | |
351 | begin | |
352 | Get_Name_String (Path_Name); | |
353 | ||
354 | for Index in reverse 1 .. Name_Len loop | |
355 | if Name_Buffer (Index) = '/' | |
356 | or else Name_Buffer (Index) = Dir_Sep | |
357 | then | |
fbf5a39b AC |
358 | -- Remove all chars after last directory separator from name |
359 | ||
360 | if Index > 1 then | |
361 | Name_Len := Index - 1; | |
362 | ||
363 | else | |
364 | Name_Len := Index; | |
365 | end if; | |
19235870 | 366 | |
19235870 RK |
367 | return Name_Find; |
368 | end if; | |
369 | end loop; | |
370 | ||
6663c393 RD |
371 | -- There is no directory separator in name. Return "./" or ".\" |
372 | ||
19235870 RK |
373 | Name_Len := 2; |
374 | Name_Buffer (1) := '.'; | |
375 | Name_Buffer (2) := Dir_Sep; | |
376 | return Name_Find; | |
377 | end Immediate_Directory_Of; | |
378 | ||
9596236a AC |
379 | ----------------------------------- |
380 | -- Look_For_Virtual_Projects_For -- | |
381 | ----------------------------------- | |
382 | ||
383 | procedure Look_For_Virtual_Projects_For | |
384 | (Proj : Project_Node_Id; | |
7e98a4c6 | 385 | In_Tree : Project_Node_Tree_Ref; |
9596236a AC |
386 | Potentially_Virtual : Boolean) |
387 | ||
388 | is | |
389 | Declaration : Project_Node_Id := Empty_Node; | |
390 | -- Node for the project declaration of Proj | |
391 | ||
392 | With_Clause : Project_Node_Id := Empty_Node; | |
393 | -- Node for a with clause of Proj | |
394 | ||
395 | Imported : Project_Node_Id := Empty_Node; | |
396 | -- Node for a project imported by Proj | |
397 | ||
398 | Extended : Project_Node_Id := Empty_Node; | |
399 | -- Node for the eventual project extended by Proj | |
400 | ||
401 | begin | |
402 | -- Nothing to do if Proj is not defined or if it has already been | |
403 | -- processed. | |
404 | ||
405 | if Proj /= Empty_Node and then not Processed_Hash.Get (Proj) then | |
406 | -- Make sure the project will not be processed again | |
407 | ||
408 | Processed_Hash.Set (Proj, True); | |
409 | ||
7e98a4c6 | 410 | Declaration := Project_Declaration_Of (Proj, In_Tree); |
9596236a AC |
411 | |
412 | if Declaration /= Empty_Node then | |
7e98a4c6 | 413 | Extended := Extended_Project_Of (Declaration, In_Tree); |
9596236a AC |
414 | end if; |
415 | ||
416 | -- If this is a project that may need a virtual extending project | |
417 | -- and it is not itself an extending project, put it in the list. | |
418 | ||
419 | if Potentially_Virtual and then Extended = Empty_Node then | |
420 | Virtual_Hash.Set (Proj, Proj); | |
421 | end if; | |
422 | ||
423 | -- Now check the projects it imports | |
424 | ||
7e98a4c6 | 425 | With_Clause := First_With_Clause_Of (Proj, In_Tree); |
9596236a AC |
426 | |
427 | while With_Clause /= Empty_Node loop | |
7e98a4c6 | 428 | Imported := Project_Node_Of (With_Clause, In_Tree); |
9596236a AC |
429 | |
430 | if Imported /= Empty_Node then | |
431 | Look_For_Virtual_Projects_For | |
7e98a4c6 | 432 | (Imported, In_Tree, Potentially_Virtual => True); |
9596236a AC |
433 | end if; |
434 | ||
7e98a4c6 | 435 | With_Clause := Next_With_Clause_Of (With_Clause, In_Tree); |
9596236a AC |
436 | end loop; |
437 | ||
438 | -- Check also the eventual project extended by Proj. As this project | |
439 | -- is already extended, call recursively with Potentially_Virtual | |
440 | -- being False. | |
441 | ||
442 | Look_For_Virtual_Projects_For | |
7e98a4c6 | 443 | (Extended, In_Tree, Potentially_Virtual => False); |
9596236a AC |
444 | end if; |
445 | end Look_For_Virtual_Projects_For; | |
446 | ||
19235870 RK |
447 | ----------- |
448 | -- Parse -- | |
449 | ----------- | |
450 | ||
451 | procedure Parse | |
7e98a4c6 VC |
452 | (In_Tree : Project_Node_Tree_Ref; |
453 | Project : out Project_Node_Id; | |
19235870 | 454 | Project_File_Name : String; |
fbf5a39b | 455 | Always_Errout_Finalize : Boolean; |
c45b6ae0 AC |
456 | Packages_To_Check : String_List_Access := All_Packages; |
457 | Store_Comments : Boolean := False) | |
19235870 RK |
458 | is |
459 | Current_Directory : constant String := Get_Current_Dir; | |
b7e429ab | 460 | Dummy : Boolean; |
19235870 RK |
461 | |
462 | begin | |
463 | Project := Empty_Node; | |
464 | ||
465 | if Current_Verbosity >= Medium then | |
466 | Write_Str ("ADA_PROJECT_PATH="""); | |
44e1918a | 467 | Write_Str (Project_Path); |
19235870 RK |
468 | Write_Line (""""); |
469 | end if; | |
470 | ||
471 | declare | |
472 | Path_Name : constant String := | |
07fc65c4 GB |
473 | Project_Path_Name_Of (Project_File_Name, |
474 | Directory => Current_Directory); | |
19235870 RK |
475 | |
476 | begin | |
fbf5a39b | 477 | Prj.Err.Initialize; |
c45b6ae0 AC |
478 | Prj.Err.Scanner.Set_Comment_As_Token (Store_Comments); |
479 | Prj.Err.Scanner.Set_End_Of_Line_As_Token (Store_Comments); | |
19235870 | 480 | |
07fc65c4 | 481 | -- Parse the main project file |
19235870 RK |
482 | |
483 | if Path_Name = "" then | |
fbf5a39b AC |
484 | Prj.Com.Fail |
485 | ("project file """, Project_File_Name, """ not found"); | |
486 | Project := Empty_Node; | |
487 | return; | |
19235870 RK |
488 | end if; |
489 | ||
490 | Parse_Single_Project | |
7e98a4c6 VC |
491 | (In_Tree => In_Tree, |
492 | Project => Project, | |
493 | Extends_All => Dummy, | |
494 | Path_Name => Path_Name, | |
495 | Extended => False, | |
496 | From_Extended => None, | |
497 | In_Limited => False, | |
498 | Packages_To_Check => Packages_To_Check); | |
9596236a AC |
499 | |
500 | -- If Project is an extending-all project, create the eventual | |
501 | -- virtual extending projects and check that there are no illegally | |
502 | -- imported projects. | |
503 | ||
7e98a4c6 VC |
504 | if Project /= Empty_Node |
505 | and then Is_Extending_All (Project, In_Tree) | |
506 | then | |
9596236a AC |
507 | -- First look for projects that potentially need a virtual |
508 | -- extending project. | |
509 | ||
510 | Virtual_Hash.Reset; | |
511 | Processed_Hash.Reset; | |
512 | ||
513 | -- Mark the extending all project as processed, to avoid checking | |
514 | -- the imported projects in case of a "limited with" on this | |
515 | -- extending all project. | |
516 | ||
517 | Processed_Hash.Set (Project, True); | |
518 | ||
519 | declare | |
520 | Declaration : constant Project_Node_Id := | |
7e98a4c6 | 521 | Project_Declaration_Of (Project, In_Tree); |
9596236a AC |
522 | begin |
523 | Look_For_Virtual_Projects_For | |
7e98a4c6 | 524 | (Extended_Project_Of (Declaration, In_Tree), In_Tree, |
9596236a AC |
525 | Potentially_Virtual => False); |
526 | end; | |
527 | ||
528 | -- Now, check the projects directly imported by the main project. | |
529 | -- Remove from the potentially virtual any project extended by one | |
530 | -- of these imported projects. For non extending imported | |
531 | -- projects, check that they do not belong to the project tree of | |
532 | -- the project being "extended-all" by the main project. | |
533 | ||
534 | declare | |
7e98a4c6 | 535 | With_Clause : Project_Node_Id; |
9596236a AC |
536 | Imported : Project_Node_Id := Empty_Node; |
537 | Declaration : Project_Node_Id := Empty_Node; | |
538 | ||
539 | begin | |
7e98a4c6 | 540 | With_Clause := First_With_Clause_Of (Project, In_Tree); |
9596236a | 541 | while With_Clause /= Empty_Node loop |
7e98a4c6 | 542 | Imported := Project_Node_Of (With_Clause, In_Tree); |
9596236a AC |
543 | |
544 | if Imported /= Empty_Node then | |
7e98a4c6 | 545 | Declaration := Project_Declaration_Of (Imported, In_Tree); |
9596236a | 546 | |
7e98a4c6 VC |
547 | if Extended_Project_Of (Declaration, In_Tree) /= |
548 | Empty_Node | |
549 | then | |
9596236a | 550 | loop |
7e98a4c6 VC |
551 | Imported := |
552 | Extended_Project_Of (Declaration, In_Tree); | |
9596236a AC |
553 | exit when Imported = Empty_Node; |
554 | Virtual_Hash.Remove (Imported); | |
7e98a4c6 VC |
555 | Declaration := |
556 | Project_Declaration_Of (Imported, In_Tree); | |
9596236a | 557 | end loop; |
9596236a | 558 | end if; |
9596236a AC |
559 | end if; |
560 | ||
7e98a4c6 | 561 | With_Clause := Next_With_Clause_Of (With_Clause, In_Tree); |
9596236a AC |
562 | end loop; |
563 | end; | |
564 | ||
565 | -- Now create all the virtual extending projects | |
566 | ||
567 | declare | |
568 | Proj : Project_Node_Id := Virtual_Hash.Get_First; | |
569 | begin | |
570 | while Proj /= Empty_Node loop | |
7e98a4c6 | 571 | Create_Virtual_Extending_Project (Proj, Project, In_Tree); |
9596236a AC |
572 | Proj := Virtual_Hash.Get_Next; |
573 | end loop; | |
574 | end; | |
575 | end if; | |
19235870 | 576 | |
07fc65c4 GB |
577 | -- If there were any kind of error during the parsing, serious |
578 | -- or not, then the parsing fails. | |
579 | ||
fbf5a39b | 580 | if Err_Vars.Total_Errors_Detected > 0 then |
19235870 RK |
581 | Project := Empty_Node; |
582 | end if; | |
583 | ||
584 | if Project = Empty_Node or else Always_Errout_Finalize then | |
fbf5a39b | 585 | Prj.Err.Finalize; |
19235870 RK |
586 | end if; |
587 | end; | |
588 | ||
589 | exception | |
590 | when X : others => | |
591 | ||
592 | -- Internal error | |
593 | ||
594 | Write_Line (Exception_Information (X)); | |
595 | Write_Str ("Exception "); | |
596 | Write_Str (Exception_Name (X)); | |
597 | Write_Line (" raised, while processing project file"); | |
598 | Project := Empty_Node; | |
599 | end Parse; | |
600 | ||
fbf5a39b AC |
601 | ------------------------------ |
602 | -- Pre_Parse_Context_Clause -- | |
603 | ------------------------------ | |
19235870 | 604 | |
7e98a4c6 VC |
605 | procedure Pre_Parse_Context_Clause |
606 | (In_Tree : Project_Node_Tree_Ref; | |
607 | Context_Clause : out With_Id) | |
608 | is | |
fbf5a39b AC |
609 | Current_With_Clause : With_Id := No_With; |
610 | Limited_With : Boolean := False; | |
611 | ||
612 | Current_With : With_Record; | |
19235870 | 613 | |
c45b6ae0 AC |
614 | Current_With_Node : Project_Node_Id := Empty_Node; |
615 | ||
19235870 RK |
616 | begin |
617 | -- Assume no context clause | |
618 | ||
fbf5a39b | 619 | Context_Clause := No_With; |
19235870 RK |
620 | With_Loop : |
621 | ||
7e98a4c6 VC |
622 | -- If Token is not WITH or LIMITED, there is no context clause, or we |
623 | -- have exhausted the with clauses. | |
19235870 | 624 | |
fbf5a39b | 625 | while Token = Tok_With or else Token = Tok_Limited loop |
7e98a4c6 VC |
626 | Current_With_Node := |
627 | Default_Project_Node (Of_Kind => N_With_Clause, In_Tree => In_Tree); | |
fbf5a39b AC |
628 | Limited_With := Token = Tok_Limited; |
629 | ||
630 | if Limited_With then | |
7e98a4c6 | 631 | Scan (In_Tree); -- scan past LIMITED |
fbf5a39b AC |
632 | Expect (Tok_With, "WITH"); |
633 | exit With_Loop when Token /= Tok_With; | |
634 | end if; | |
635 | ||
19235870 RK |
636 | Comma_Loop : |
637 | loop | |
7e98a4c6 | 638 | Scan (In_Tree); -- scan past WITH or "," |
19235870 | 639 | |
19235870 RK |
640 | Expect (Tok_String_Literal, "literal string"); |
641 | ||
642 | if Token /= Tok_String_Literal then | |
643 | return; | |
644 | end if; | |
645 | ||
fbf5a39b | 646 | -- Store path and location in table Withs |
19235870 | 647 | |
fbf5a39b AC |
648 | Current_With := |
649 | (Path => Token_Name, | |
650 | Location => Token_Ptr, | |
651 | Limited_With => Limited_With, | |
c45b6ae0 | 652 | Node => Current_With_Node, |
fbf5a39b | 653 | Next => No_With); |
19235870 | 654 | |
fbf5a39b AC |
655 | Withs.Increment_Last; |
656 | Withs.Table (Withs.Last) := Current_With; | |
19235870 | 657 | |
fbf5a39b AC |
658 | if Current_With_Clause = No_With then |
659 | Context_Clause := Withs.Last; | |
19235870 | 660 | |
fbf5a39b AC |
661 | else |
662 | Withs.Table (Current_With_Clause).Next := Withs.Last; | |
663 | end if; | |
664 | ||
665 | Current_With_Clause := Withs.Last; | |
19235870 | 666 | |
7e98a4c6 | 667 | Scan (In_Tree); |
19235870 | 668 | |
fbf5a39b | 669 | if Token = Tok_Semicolon then |
c45b6ae0 AC |
670 | Set_End_Of_Line (Current_With_Node); |
671 | Set_Previous_Line_Node (Current_With_Node); | |
19235870 | 672 | |
fbf5a39b | 673 | -- End of (possibly multiple) with clause; |
19235870 | 674 | |
7e98a4c6 | 675 | Scan (In_Tree); -- scan past the semicolon. |
fbf5a39b | 676 | exit Comma_Loop; |
07fc65c4 | 677 | |
a493557f VC |
678 | elsif Token = Tok_Comma then |
679 | Set_Is_Not_Last_In_List (Current_With_Node, In_Tree); | |
680 | ||
681 | else | |
fbf5a39b AC |
682 | Error_Msg ("expected comma or semi colon", Token_Ptr); |
683 | exit Comma_Loop; | |
684 | end if; | |
c45b6ae0 AC |
685 | |
686 | Current_With_Node := | |
7e98a4c6 VC |
687 | Default_Project_Node |
688 | (Of_Kind => N_With_Clause, In_Tree => In_Tree); | |
fbf5a39b AC |
689 | end loop Comma_Loop; |
690 | end loop With_Loop; | |
691 | end Pre_Parse_Context_Clause; | |
07fc65c4 | 692 | |
fbf5a39b AC |
693 | ------------------------------- |
694 | -- Post_Parse_Context_Clause -- | |
695 | ------------------------------- | |
07fc65c4 | 696 | |
fbf5a39b AC |
697 | procedure Post_Parse_Context_Clause |
698 | (Context_Clause : With_Id; | |
7e98a4c6 | 699 | In_Tree : Project_Node_Tree_Ref; |
fbf5a39b AC |
700 | Imported_Projects : out Project_Node_Id; |
701 | Project_Directory : Name_Id; | |
0da2c8ac | 702 | From_Extended : Extension_Origin; |
7e98a4c6 VC |
703 | In_Limited : Boolean; |
704 | Packages_To_Check : String_List_Access) | |
fbf5a39b AC |
705 | is |
706 | Current_With_Clause : With_Id := Context_Clause; | |
07fc65c4 | 707 | |
fbf5a39b AC |
708 | Current_Project : Project_Node_Id := Empty_Node; |
709 | Previous_Project : Project_Node_Id := Empty_Node; | |
710 | Next_Project : Project_Node_Id := Empty_Node; | |
07fc65c4 | 711 | |
fbf5a39b AC |
712 | Project_Directory_Path : constant String := |
713 | Get_Name_String (Project_Directory); | |
07fc65c4 | 714 | |
fbf5a39b AC |
715 | Current_With : With_Record; |
716 | Limited_With : Boolean := False; | |
b7e429ab | 717 | Extends_All : Boolean := False; |
07fc65c4 | 718 | |
fbf5a39b AC |
719 | begin |
720 | Imported_Projects := Empty_Node; | |
19235870 | 721 | |
fbf5a39b AC |
722 | while Current_With_Clause /= No_With loop |
723 | Current_With := Withs.Table (Current_With_Clause); | |
724 | Current_With_Clause := Current_With.Next; | |
725 | ||
0da2c8ac | 726 | Limited_With := In_Limited or Current_With.Limited_With; |
19235870 | 727 | |
fbf5a39b AC |
728 | declare |
729 | Original_Path : constant String := | |
7e98a4c6 | 730 | Get_Name_String (Current_With.Path); |
19235870 | 731 | |
fbf5a39b AC |
732 | Imported_Path_Name : constant String := |
733 | Project_Path_Name_Of | |
7e98a4c6 | 734 | (Original_Path, Project_Directory_Path); |
19235870 | 735 | |
9a080ea3 VC |
736 | Resolved_Path : constant String := |
737 | Normalize_Pathname | |
738 | (Imported_Path_Name, | |
739 | Resolve_Links => True, | |
44e1918a | 740 | Case_Sensitive => True); |
9a080ea3 | 741 | |
fbf5a39b AC |
742 | Withed_Project : Project_Node_Id := Empty_Node; |
743 | ||
744 | begin | |
745 | if Imported_Path_Name = "" then | |
746 | ||
747 | -- The project file cannot be found | |
748 | ||
749 | Error_Msg_Name_1 := Current_With.Path; | |
750 | ||
751 | Error_Msg ("unknown project file: {", Current_With.Location); | |
752 | ||
753 | -- If this is not imported by the main project file, | |
754 | -- display the import path. | |
755 | ||
756 | if Project_Stack.Last > 1 then | |
757 | for Index in reverse 1 .. Project_Stack.Last loop | |
6871ba5f | 758 | Error_Msg_Name_1 := Project_Stack.Table (Index).Path_Name; |
fbf5a39b AC |
759 | Error_Msg ("\imported by {", Current_With.Location); |
760 | end loop; | |
19235870 | 761 | end if; |
19235870 | 762 | |
fbf5a39b AC |
763 | else |
764 | -- New with clause | |
19235870 | 765 | |
fbf5a39b | 766 | Previous_Project := Current_Project; |
19235870 | 767 | |
fbf5a39b | 768 | if Current_Project = Empty_Node then |
19235870 | 769 | |
fbf5a39b | 770 | -- First with clause of the context clause |
19235870 | 771 | |
c45b6ae0 | 772 | Current_Project := Current_With.Node; |
fbf5a39b AC |
773 | Imported_Projects := Current_Project; |
774 | ||
775 | else | |
c45b6ae0 | 776 | Next_Project := Current_With.Node; |
7e98a4c6 VC |
777 | Set_Next_With_Clause_Of |
778 | (Current_Project, In_Tree, Next_Project); | |
fbf5a39b AC |
779 | Current_Project := Next_Project; |
780 | end if; | |
781 | ||
782 | Set_String_Value_Of | |
7e98a4c6 VC |
783 | (Current_Project, In_Tree, Current_With.Path); |
784 | Set_Location_Of | |
785 | (Current_Project, In_Tree, Current_With.Location); | |
fbf5a39b | 786 | |
9a080ea3 VC |
787 | -- If this is a "limited with", check if we have a circularity. |
788 | -- If we have one, get the project id of the limited imported | |
789 | -- project file, and do not parse it. | |
fbf5a39b AC |
790 | |
791 | if Limited_With and then Project_Stack.Last > 1 then | |
792 | declare | |
fbf5a39b AC |
793 | Canonical_Path_Name : Name_Id; |
794 | ||
795 | begin | |
9a080ea3 VC |
796 | Name_Len := Resolved_Path'Length; |
797 | Name_Buffer (1 .. Name_Len) := Resolved_Path; | |
44e1918a | 798 | Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); |
fbf5a39b AC |
799 | Canonical_Path_Name := Name_Find; |
800 | ||
801 | for Index in 1 .. Project_Stack.Last loop | |
6871ba5f | 802 | if Project_Stack.Table (Index).Canonical_Path_Name = |
8a7988f5 | 803 | Canonical_Path_Name |
fbf5a39b AC |
804 | then |
805 | -- We have found the limited imported project, | |
8a7988f5 | 806 | -- get its project id, and do not parse it. |
fbf5a39b AC |
807 | |
808 | Withed_Project := Project_Stack.Table (Index).Id; | |
809 | exit; | |
810 | end if; | |
811 | end loop; | |
812 | end; | |
813 | end if; | |
814 | ||
815 | -- Parse the imported project, if its project id is unknown | |
816 | ||
817 | if Withed_Project = Empty_Node then | |
818 | Parse_Single_Project | |
7e98a4c6 VC |
819 | (In_Tree => In_Tree, |
820 | Project => Withed_Project, | |
821 | Extends_All => Extends_All, | |
822 | Path_Name => Imported_Path_Name, | |
823 | Extended => False, | |
824 | From_Extended => From_Extended, | |
825 | In_Limited => Limited_With, | |
826 | Packages_To_Check => Packages_To_Check); | |
b7e429ab AC |
827 | |
828 | else | |
7e98a4c6 | 829 | Extends_All := Is_Extending_All (Withed_Project, In_Tree); |
fbf5a39b AC |
830 | end if; |
831 | ||
832 | if Withed_Project = Empty_Node then | |
833 | -- If parsing was not successful, remove the | |
834 | -- context clause. | |
835 | ||
836 | Current_Project := Previous_Project; | |
837 | ||
838 | if Current_Project = Empty_Node then | |
839 | Imported_Projects := Empty_Node; | |
840 | ||
841 | else | |
842 | Set_Next_With_Clause_Of | |
7e98a4c6 | 843 | (Current_Project, In_Tree, Empty_Node); |
fbf5a39b AC |
844 | end if; |
845 | else | |
846 | -- If parsing was successful, record project name | |
847 | -- and path name in with clause | |
848 | ||
849 | Set_Project_Node_Of | |
850 | (Node => Current_Project, | |
7e98a4c6 | 851 | In_Tree => In_Tree, |
fbf5a39b | 852 | To => Withed_Project, |
7e98a4c6 VC |
853 | Limited_With => Current_With.Limited_With); |
854 | Set_Name_Of | |
855 | (Current_Project, | |
856 | In_Tree, | |
857 | Name_Of (Withed_Project, In_Tree)); | |
9a080ea3 VC |
858 | |
859 | Name_Len := Resolved_Path'Length; | |
860 | Name_Buffer (1 .. Name_Len) := Resolved_Path; | |
7e98a4c6 | 861 | Set_Path_Name_Of (Current_Project, In_Tree, Name_Find); |
b7e429ab AC |
862 | |
863 | if Extends_All then | |
7e98a4c6 | 864 | Set_Is_Extending_All (Current_Project, In_Tree); |
b7e429ab | 865 | end if; |
fbf5a39b AC |
866 | end if; |
867 | end if; | |
868 | end; | |
869 | end loop; | |
870 | end Post_Parse_Context_Clause; | |
19235870 RK |
871 | |
872 | -------------------------- | |
873 | -- Parse_Single_Project -- | |
874 | -------------------------- | |
875 | ||
876 | procedure Parse_Single_Project | |
7e98a4c6 VC |
877 | (In_Tree : Project_Node_Tree_Ref; |
878 | Project : out Project_Node_Id; | |
879 | Extends_All : out Boolean; | |
880 | Path_Name : String; | |
881 | Extended : Boolean; | |
882 | From_Extended : Extension_Origin; | |
883 | In_Limited : Boolean; | |
884 | Packages_To_Check : String_List_Access) | |
19235870 | 885 | is |
fbf5a39b | 886 | Normed_Path_Name : Name_Id; |
19235870 RK |
887 | Canonical_Path_Name : Name_Id; |
888 | Project_Directory : Name_Id; | |
889 | Project_Scan_State : Saved_Project_Scan_State; | |
890 | Source_Index : Source_File_Index; | |
891 | ||
5c1c8a03 AC |
892 | Extending : Boolean := False; |
893 | ||
fbf5a39b | 894 | Extended_Project : Project_Node_Id := Empty_Node; |
19235870 RK |
895 | |
896 | A_Project_Name_And_Node : Tree_Private_Part.Project_Name_And_Node := | |
7e98a4c6 VC |
897 | Tree_Private_Part.Projects_Htable.Get_First |
898 | (In_Tree.Projects_HT); | |
19235870 RK |
899 | |
900 | Name_From_Path : constant Name_Id := Project_Name_From (Path_Name); | |
901 | ||
fbf5a39b AC |
902 | Name_Of_Project : Name_Id := No_Name; |
903 | ||
904 | First_With : With_Id; | |
905 | ||
19235870 RK |
906 | use Tree_Private_Part; |
907 | ||
c45b6ae0 AC |
908 | Project_Comment_State : Tree.Comment_State; |
909 | ||
19235870 | 910 | begin |
b7e429ab AC |
911 | Extends_All := False; |
912 | ||
fbf5a39b | 913 | declare |
2820d220 AC |
914 | Normed_Path : constant String := Normalize_Pathname |
915 | (Path_Name, Resolve_Links => False, | |
916 | Case_Sensitive => True); | |
6d11af89 | 917 | Canonical_Path : constant String := Normalize_Pathname |
2820d220 AC |
918 | (Normed_Path, Resolve_Links => True, |
919 | Case_Sensitive => False); | |
6d11af89 | 920 | |
fbf5a39b | 921 | begin |
6d11af89 AC |
922 | Name_Len := Normed_Path'Length; |
923 | Name_Buffer (1 .. Name_Len) := Normed_Path; | |
fbf5a39b | 924 | Normed_Path_Name := Name_Find; |
6d11af89 AC |
925 | Name_Len := Canonical_Path'Length; |
926 | Name_Buffer (1 .. Name_Len) := Canonical_Path; | |
fbf5a39b AC |
927 | Canonical_Path_Name := Name_Find; |
928 | end; | |
19235870 RK |
929 | |
930 | -- Check for a circular dependency | |
931 | ||
932 | for Index in 1 .. Project_Stack.Last loop | |
6871ba5f AC |
933 | if Canonical_Path_Name = |
934 | Project_Stack.Table (Index).Canonical_Path_Name | |
935 | then | |
19235870 | 936 | Error_Msg ("circular dependency detected", Token_Ptr); |
fbf5a39b | 937 | Error_Msg_Name_1 := Normed_Path_Name; |
19235870 RK |
938 | Error_Msg ("\ { is imported by", Token_Ptr); |
939 | ||
940 | for Current in reverse 1 .. Project_Stack.Last loop | |
6871ba5f | 941 | Error_Msg_Name_1 := Project_Stack.Table (Current).Path_Name; |
19235870 | 942 | |
555360a5 AC |
943 | if Project_Stack.Table (Current).Canonical_Path_Name /= |
944 | Canonical_Path_Name | |
945 | then | |
19235870 RK |
946 | Error_Msg |
947 | ("\ { which itself is imported by", Token_Ptr); | |
948 | ||
949 | else | |
950 | Error_Msg ("\ {", Token_Ptr); | |
951 | exit; | |
952 | end if; | |
953 | end loop; | |
954 | ||
955 | Project := Empty_Node; | |
956 | return; | |
957 | end if; | |
958 | end loop; | |
959 | ||
c45b6ae0 AC |
960 | -- Put the new path name on the stack |
961 | ||
19235870 | 962 | Project_Stack.Increment_Last; |
6871ba5f AC |
963 | Project_Stack.Table (Project_Stack.Last).Path_Name := Normed_Path_Name; |
964 | Project_Stack.Table (Project_Stack.Last).Canonical_Path_Name := | |
965 | Canonical_Path_Name; | |
19235870 | 966 | |
44e1918a | 967 | -- Check if the project file has already been parsed |
19235870 RK |
968 | |
969 | while | |
970 | A_Project_Name_And_Node /= Tree_Private_Part.No_Project_Name_And_Node | |
971 | loop | |
44e1918a AC |
972 | if A_Project_Name_And_Node.Canonical_Path = Canonical_Path_Name then |
973 | if Extended then | |
19235870 | 974 | |
44e1918a AC |
975 | if A_Project_Name_And_Node.Extended then |
976 | Error_Msg | |
977 | ("cannot extend the same project file several times", | |
978 | Token_Ptr); | |
979 | else | |
980 | Error_Msg | |
981 | ("cannot extend an already imported project file", | |
982 | Token_Ptr); | |
983 | end if; | |
fbf5a39b | 984 | |
44e1918a AC |
985 | elsif A_Project_Name_And_Node.Extended then |
986 | Extends_All := | |
7e98a4c6 | 987 | Is_Extending_All (A_Project_Name_And_Node.Node, In_Tree); |
6871ba5f | 988 | |
44e1918a AC |
989 | -- If the imported project is an extended project A, |
990 | -- and we are in an extended project, replace A with the | |
991 | -- ultimate project extending A. | |
6871ba5f | 992 | |
44e1918a AC |
993 | if From_Extended /= None then |
994 | declare | |
995 | Decl : Project_Node_Id := | |
996 | Project_Declaration_Of | |
7e98a4c6 | 997 | (A_Project_Name_And_Node.Node, In_Tree); |
8a7988f5 | 998 | |
7e98a4c6 VC |
999 | Prj : Project_Node_Id := |
1000 | Extending_Project_Of (Decl, In_Tree); | |
8a7988f5 | 1001 | |
44e1918a AC |
1002 | begin |
1003 | loop | |
7e98a4c6 VC |
1004 | Decl := Project_Declaration_Of (Prj, In_Tree); |
1005 | exit when Extending_Project_Of (Decl, In_Tree) = | |
1006 | Empty_Node; | |
1007 | Prj := Extending_Project_Of (Decl, In_Tree); | |
44e1918a | 1008 | end loop; |
fbf5a39b | 1009 | |
44e1918a AC |
1010 | A_Project_Name_And_Node.Node := Prj; |
1011 | end; | |
1012 | else | |
1013 | Error_Msg | |
1014 | ("cannot import an already extended project file", | |
1015 | Token_Ptr); | |
fbf5a39b | 1016 | end if; |
6871ba5f | 1017 | end if; |
44e1918a AC |
1018 | |
1019 | Project := A_Project_Name_And_Node.Node; | |
1020 | Project_Stack.Decrement_Last; | |
1021 | return; | |
1022 | end if; | |
19235870 | 1023 | |
7e98a4c6 VC |
1024 | A_Project_Name_And_Node := |
1025 | Tree_Private_Part.Projects_Htable.Get_Next (In_Tree.Projects_HT); | |
19235870 RK |
1026 | end loop; |
1027 | ||
1028 | -- We never encountered this project file | |
1029 | -- Save the scan state, load the project file and start to scan it. | |
1030 | ||
1031 | Save_Project_Scan_State (Project_Scan_State); | |
1032 | Source_Index := Load_Project_File (Path_Name); | |
c45b6ae0 | 1033 | Tree.Save (Project_Comment_State); |
19235870 | 1034 | |
8a7988f5 | 1035 | -- If we cannot find it, we stop |
19235870 RK |
1036 | |
1037 | if Source_Index = No_Source_File then | |
1038 | Project := Empty_Node; | |
1039 | Project_Stack.Decrement_Last; | |
1040 | return; | |
1041 | end if; | |
1042 | ||
68e2ea27 | 1043 | Prj.Err.Scanner.Initialize_Scanner (Source_Index); |
c45b6ae0 | 1044 | Tree.Reset_State; |
7e98a4c6 | 1045 | Scan (In_Tree); |
19235870 RK |
1046 | |
1047 | if Name_From_Path = No_Name then | |
1048 | ||
1049 | -- The project file name is not correct (no or bad extension, | |
1050 | -- or not following Ada identifier's syntax). | |
1051 | ||
1052 | Error_Msg_Name_1 := Canonical_Path_Name; | |
1053 | Error_Msg ("?{ is not a valid path name for a project file", | |
1054 | Token_Ptr); | |
1055 | end if; | |
1056 | ||
1057 | if Current_Verbosity >= Medium then | |
1058 | Write_Str ("Parsing """); | |
1059 | Write_Str (Path_Name); | |
1060 | Write_Char ('"'); | |
1061 | Write_Eol; | |
1062 | end if; | |
1063 | ||
c45b6ae0 AC |
1064 | -- Is there any imported project? |
1065 | ||
7e98a4c6 | 1066 | Pre_Parse_Context_Clause (In_Tree, First_With); |
c45b6ae0 | 1067 | |
fbf5a39b | 1068 | Project_Directory := Immediate_Directory_Of (Normed_Path_Name); |
7e98a4c6 VC |
1069 | Project := Default_Project_Node |
1070 | (Of_Kind => N_Project, In_Tree => In_Tree); | |
fbf5a39b | 1071 | Project_Stack.Table (Project_Stack.Last).Id := Project; |
7e98a4c6 VC |
1072 | Set_Directory_Of (Project, In_Tree, Project_Directory); |
1073 | Set_Path_Name_Of (Project, In_Tree, Normed_Path_Name); | |
1074 | Set_Location_Of (Project, In_Tree, Token_Ptr); | |
19235870 | 1075 | |
fbf5a39b | 1076 | Expect (Tok_Project, "PROJECT"); |
19235870 | 1077 | |
6663c393 | 1078 | -- Mark location of PROJECT token if present |
19235870 RK |
1079 | |
1080 | if Token = Tok_Project then | |
c8b0c260 | 1081 | Scan (In_Tree); -- scan past PROJECT |
7e98a4c6 | 1082 | Set_Location_Of (Project, In_Tree, Token_Ptr); |
19235870 RK |
1083 | end if; |
1084 | ||
fbf5a39b AC |
1085 | -- Clear the Buffer |
1086 | ||
1087 | Buffer_Last := 0; | |
fbf5a39b AC |
1088 | loop |
1089 | Expect (Tok_Identifier, "identifier"); | |
1090 | ||
1091 | -- If the token is not an identifier, clear the buffer before | |
1092 | -- exiting to indicate that the name of the project is ill-formed. | |
1093 | ||
1094 | if Token /= Tok_Identifier then | |
1095 | Buffer_Last := 0; | |
1096 | exit; | |
1097 | end if; | |
1098 | ||
1099 | -- Add the identifier name to the buffer | |
19235870 RK |
1100 | |
1101 | Get_Name_String (Token_Name); | |
7e98a4c6 | 1102 | Add_To_Buffer (Name_Buffer (1 .. Name_Len), Buffer, Buffer_Last); |
fbf5a39b AC |
1103 | |
1104 | -- Scan past the identifier | |
1105 | ||
7e98a4c6 | 1106 | Scan (In_Tree); |
fbf5a39b AC |
1107 | |
1108 | -- If we have a dot, add a dot the the Buffer and look for the next | |
1109 | -- identifier. | |
1110 | ||
1111 | exit when Token /= Tok_Dot; | |
7e98a4c6 | 1112 | Add_To_Buffer (".", Buffer, Buffer_Last); |
fbf5a39b AC |
1113 | |
1114 | -- Scan past the dot | |
1115 | ||
7e98a4c6 | 1116 | Scan (In_Tree); |
fbf5a39b AC |
1117 | end loop; |
1118 | ||
5c1c8a03 AC |
1119 | -- See if this is an extending project |
1120 | ||
1121 | if Token = Tok_Extends then | |
1122 | ||
1123 | -- Make sure that gnatmake will use mapping files | |
1124 | ||
1125 | Create_Mapping_File := True; | |
1126 | ||
1127 | -- We are extending another project | |
1128 | ||
1129 | Extending := True; | |
1130 | ||
7e98a4c6 | 1131 | Scan (In_Tree); -- scan past EXTENDS |
5c1c8a03 AC |
1132 | |
1133 | if Token = Tok_All then | |
1134 | Extends_All := True; | |
7e98a4c6 VC |
1135 | Set_Is_Extending_All (Project, In_Tree); |
1136 | Scan (In_Tree); -- scan past ALL | |
5c1c8a03 AC |
1137 | end if; |
1138 | end if; | |
1139 | ||
fbf5a39b AC |
1140 | -- If the name is well formed, Buffer_Last is > 0 |
1141 | ||
1142 | if Buffer_Last > 0 then | |
1143 | ||
1144 | -- The Buffer contains the name of the project | |
1145 | ||
1146 | Name_Len := Buffer_Last; | |
1147 | Name_Buffer (1 .. Name_Len) := Buffer (1 .. Buffer_Last); | |
1148 | Name_Of_Project := Name_Find; | |
7e98a4c6 | 1149 | Set_Name_Of (Project, In_Tree, Name_Of_Project); |
fbf5a39b AC |
1150 | |
1151 | -- To get expected name of the project file, replace dots by dashes | |
1152 | ||
1153 | Name_Len := Buffer_Last; | |
1154 | Name_Buffer (1 .. Name_Len) := Buffer (1 .. Buffer_Last); | |
1155 | ||
1156 | for Index in 1 .. Name_Len loop | |
1157 | if Name_Buffer (Index) = '.' then | |
1158 | Name_Buffer (Index) := '-'; | |
1159 | end if; | |
1160 | end loop; | |
1161 | ||
19235870 RK |
1162 | Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); |
1163 | ||
1164 | declare | |
1165 | Expected_Name : constant Name_Id := Name_Find; | |
1166 | ||
1167 | begin | |
fbf5a39b AC |
1168 | -- Output a warning if the actual name is not the expected name |
1169 | ||
19235870 RK |
1170 | if Name_From_Path /= No_Name |
1171 | and then Expected_Name /= Name_From_Path | |
1172 | then | |
19235870 RK |
1173 | Error_Msg_Name_1 := Expected_Name; |
1174 | Error_Msg ("?file name does not match unit name, " & | |
1175 | "should be `{" & Project_File_Extension & "`", | |
1176 | Token_Ptr); | |
1177 | end if; | |
1178 | end; | |
1179 | ||
fbf5a39b AC |
1180 | declare |
1181 | Imported_Projects : Project_Node_Id := Empty_Node; | |
9596236a | 1182 | From_Ext : Extension_Origin := None; |
fbf5a39b AC |
1183 | |
1184 | begin | |
9596236a AC |
1185 | -- Extending_All is always propagated |
1186 | ||
5c1c8a03 | 1187 | if From_Extended = Extending_All or else Extends_All then |
9596236a AC |
1188 | From_Ext := Extending_All; |
1189 | ||
1190 | -- Otherwise, From_Extended is set to Extending_Single if the | |
1191 | -- current project is an extending project. | |
1192 | ||
1193 | elsif Extended then | |
1194 | From_Ext := Extending_Simple; | |
1195 | end if; | |
1196 | ||
fbf5a39b | 1197 | Post_Parse_Context_Clause |
7e98a4c6 VC |
1198 | (In_Tree => In_Tree, |
1199 | Context_Clause => First_With, | |
fbf5a39b AC |
1200 | Imported_Projects => Imported_Projects, |
1201 | Project_Directory => Project_Directory, | |
0da2c8ac | 1202 | From_Extended => From_Ext, |
7e98a4c6 VC |
1203 | In_Limited => In_Limited, |
1204 | Packages_To_Check => Packages_To_Check); | |
1205 | Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects); | |
fbf5a39b AC |
1206 | end; |
1207 | ||
19235870 | 1208 | declare |
cc335f43 | 1209 | Name_And_Node : Tree_Private_Part.Project_Name_And_Node := |
7e98a4c6 VC |
1210 | Tree_Private_Part.Projects_Htable.Get_First |
1211 | (In_Tree.Projects_HT); | |
cc335f43 | 1212 | Project_Name : Name_Id := Name_And_Node.Name; |
19235870 RK |
1213 | |
1214 | begin | |
1215 | -- Check if we already have a project with this name | |
1216 | ||
1217 | while Project_Name /= No_Name | |
fbf5a39b | 1218 | and then Project_Name /= Name_Of_Project |
19235870 | 1219 | loop |
7e98a4c6 VC |
1220 | Name_And_Node := |
1221 | Tree_Private_Part.Projects_Htable.Get_Next | |
1222 | (In_Tree.Projects_HT); | |
cc335f43 | 1223 | Project_Name := Name_And_Node.Name; |
19235870 RK |
1224 | end loop; |
1225 | ||
fbf5a39b AC |
1226 | -- Report an error if we already have a project with this name |
1227 | ||
19235870 | 1228 | if Project_Name /= No_Name then |
cc335f43 | 1229 | Error_Msg_Name_1 := Project_Name; |
7e98a4c6 VC |
1230 | Error_Msg |
1231 | ("duplicate project name {", Location_Of (Project, In_Tree)); | |
1232 | Error_Msg_Name_1 := | |
1233 | Path_Name_Of (Name_And_Node.Node, In_Tree); | |
1234 | Error_Msg | |
1235 | ("\already in {", Location_Of (Project, In_Tree)); | |
19235870 RK |
1236 | |
1237 | else | |
fbf5a39b AC |
1238 | -- Otherwise, add the name of the project to the hash table, so |
1239 | -- that we can check that no other subsequent project will have | |
1240 | -- the same name. | |
1241 | ||
19235870 | 1242 | Tree_Private_Part.Projects_Htable.Set |
7e98a4c6 VC |
1243 | (T => In_Tree.Projects_HT, |
1244 | K => Name_Of_Project, | |
44e1918a AC |
1245 | E => (Name => Name_Of_Project, |
1246 | Node => Project, | |
1247 | Canonical_Path => Canonical_Path_Name, | |
1248 | Extended => Extended)); | |
19235870 RK |
1249 | end if; |
1250 | end; | |
1251 | ||
19235870 RK |
1252 | end if; |
1253 | ||
5c1c8a03 | 1254 | if Extending then |
19235870 RK |
1255 | Expect (Tok_String_Literal, "literal string"); |
1256 | ||
1257 | if Token = Tok_String_Literal then | |
7e98a4c6 | 1258 | Set_Extended_Project_Path_Of (Project, In_Tree, Token_Name); |
19235870 RK |
1259 | |
1260 | declare | |
1261 | Original_Path_Name : constant String := | |
fbf5a39b | 1262 | Get_Name_String (Token_Name); |
19235870 | 1263 | |
fbf5a39b | 1264 | Extended_Project_Path_Name : constant String := |
19235870 RK |
1265 | Project_Path_Name_Of |
1266 | (Original_Path_Name, | |
7e98a4c6 VC |
1267 | Get_Name_String |
1268 | (Project_Directory)); | |
19235870 RK |
1269 | |
1270 | begin | |
fbf5a39b | 1271 | if Extended_Project_Path_Name = "" then |
19235870 | 1272 | |
fbf5a39b | 1273 | -- We could not find the project file to extend |
19235870 | 1274 | |
fbf5a39b | 1275 | Error_Msg_Name_1 := Token_Name; |
19235870 RK |
1276 | |
1277 | Error_Msg ("unknown project file: {", Token_Ptr); | |
1278 | ||
07fc65c4 GB |
1279 | -- If we are not in the main project file, display the |
1280 | -- import path. | |
1281 | ||
1282 | if Project_Stack.Last > 1 then | |
1283 | Error_Msg_Name_1 := | |
6871ba5f | 1284 | Project_Stack.Table (Project_Stack.Last).Path_Name; |
07fc65c4 GB |
1285 | Error_Msg ("\extended by {", Token_Ptr); |
1286 | ||
1287 | for Index in reverse 1 .. Project_Stack.Last - 1 loop | |
6871ba5f AC |
1288 | Error_Msg_Name_1 := |
1289 | Project_Stack.Table (Index).Path_Name; | |
07fc65c4 GB |
1290 | Error_Msg ("\imported by {", Token_Ptr); |
1291 | end loop; | |
1292 | end if; | |
1293 | ||
19235870 | 1294 | else |
9596236a | 1295 | declare |
5c1c8a03 | 1296 | From_Ext : Extension_Origin := None; |
9596236a AC |
1297 | |
1298 | begin | |
5c1c8a03 AC |
1299 | if From_Extended = Extending_All or else Extends_All then |
1300 | From_Ext := Extending_All; | |
9596236a AC |
1301 | end if; |
1302 | ||
1303 | Parse_Single_Project | |
7e98a4c6 VC |
1304 | (In_Tree => In_Tree, |
1305 | Project => Extended_Project, | |
1306 | Extends_All => Extends_All, | |
1307 | Path_Name => Extended_Project_Path_Name, | |
1308 | Extended => True, | |
1309 | From_Extended => From_Ext, | |
1310 | In_Limited => In_Limited, | |
1311 | Packages_To_Check => Packages_To_Check); | |
9596236a AC |
1312 | end; |
1313 | ||
1314 | -- A project that extends an extending-all project is also | |
1315 | -- an extending-all project. | |
1316 | ||
9a080ea3 | 1317 | if Extended_Project /= Empty_Node |
7e98a4c6 | 1318 | and then Is_Extending_All (Extended_Project, In_Tree) |
9a080ea3 | 1319 | then |
7e98a4c6 | 1320 | Set_Is_Extending_All (Project, In_Tree); |
9596236a | 1321 | end if; |
19235870 RK |
1322 | end if; |
1323 | end; | |
1324 | ||
7e98a4c6 | 1325 | Scan (In_Tree); -- scan past the extended project path |
19235870 RK |
1326 | end if; |
1327 | end if; | |
1328 | ||
9596236a AC |
1329 | -- Check that a non extending-all project does not import an |
1330 | -- extending-all project. | |
1331 | ||
7e98a4c6 | 1332 | if not Is_Extending_All (Project, In_Tree) then |
9596236a | 1333 | declare |
7e98a4c6 VC |
1334 | With_Clause : Project_Node_Id := |
1335 | First_With_Clause_Of (Project, In_Tree); | |
9596236a AC |
1336 | Imported : Project_Node_Id := Empty_Node; |
1337 | ||
1338 | begin | |
1339 | With_Clause_Loop : | |
1340 | while With_Clause /= Empty_Node loop | |
7e98a4c6 | 1341 | Imported := Project_Node_Of (With_Clause, In_Tree); |
9596236a | 1342 | |
7e98a4c6 VC |
1343 | if Is_Extending_All (With_Clause, In_Tree) then |
1344 | Error_Msg_Name_1 := Name_Of (Imported, In_Tree); | |
9596236a AC |
1345 | Error_Msg ("cannot import extending-all project {", |
1346 | Token_Ptr); | |
1347 | exit With_Clause_Loop; | |
1348 | end if; | |
b7e429ab | 1349 | |
7e98a4c6 | 1350 | With_Clause := Next_With_Clause_Of (With_Clause, In_Tree); |
9596236a AC |
1351 | end loop With_Clause_Loop; |
1352 | end; | |
1353 | end if; | |
1354 | ||
fbf5a39b AC |
1355 | -- Check that a project with a name including a dot either imports |
1356 | -- or extends the project whose name precedes the last dot. | |
1357 | ||
1358 | if Name_Of_Project /= No_Name then | |
1359 | Get_Name_String (Name_Of_Project); | |
1360 | ||
1361 | else | |
1362 | Name_Len := 0; | |
1363 | end if; | |
1364 | ||
1365 | -- Look for the last dot | |
1366 | ||
1367 | while Name_Len > 0 and then Name_Buffer (Name_Len) /= '.' loop | |
1368 | Name_Len := Name_Len - 1; | |
1369 | end loop; | |
1370 | ||
1371 | -- If a dot was find, check if the parent project is imported | |
1372 | -- or extended. | |
1373 | ||
1374 | if Name_Len > 0 then | |
1375 | Name_Len := Name_Len - 1; | |
1376 | ||
1377 | declare | |
1378 | Parent_Name : constant Name_Id := Name_Find; | |
1379 | Parent_Found : Boolean := False; | |
7e98a4c6 VC |
1380 | With_Clause : Project_Node_Id := |
1381 | First_With_Clause_Of (Project, In_Tree); | |
fbf5a39b AC |
1382 | |
1383 | begin | |
1384 | -- If there is an extended project, check its name | |
1385 | ||
1386 | if Extended_Project /= Empty_Node then | |
7e98a4c6 VC |
1387 | Parent_Found := |
1388 | Name_Of (Extended_Project, In_Tree) = Parent_Name; | |
fbf5a39b AC |
1389 | end if; |
1390 | ||
1391 | -- If the parent project is not the extended project, | |
1392 | -- check each imported project until we find the parent project. | |
1393 | ||
1394 | while not Parent_Found and then With_Clause /= Empty_Node loop | |
7e98a4c6 VC |
1395 | Parent_Found := |
1396 | Name_Of (Project_Node_Of (With_Clause, In_Tree), In_Tree) = | |
1397 | Parent_Name; | |
1398 | With_Clause := Next_With_Clause_Of (With_Clause, In_Tree); | |
fbf5a39b AC |
1399 | end loop; |
1400 | ||
1401 | -- If the parent project was not found, report an error | |
1402 | ||
1403 | if not Parent_Found then | |
1404 | Error_Msg_Name_1 := Name_Of_Project; | |
1405 | Error_Msg_Name_2 := Parent_Name; | |
1406 | Error_Msg ("project { does not import or extend project {", | |
7e98a4c6 | 1407 | Location_Of (Project, In_Tree)); |
fbf5a39b AC |
1408 | end if; |
1409 | end; | |
1410 | end if; | |
1411 | ||
1412 | Expect (Tok_Is, "IS"); | |
c45b6ae0 AC |
1413 | Set_End_Of_Line (Project); |
1414 | Set_Previous_Line_Node (Project); | |
1415 | Set_Next_End_Node (Project); | |
19235870 RK |
1416 | |
1417 | declare | |
1418 | Project_Declaration : Project_Node_Id := Empty_Node; | |
1419 | ||
1420 | begin | |
44e1918a | 1421 | -- No need to Scan past "is", Prj.Dect.Parse will do it |
19235870 RK |
1422 | |
1423 | Prj.Dect.Parse | |
7e98a4c6 VC |
1424 | (In_Tree => In_Tree, |
1425 | Declarations => Project_Declaration, | |
1426 | Current_Project => Project, | |
1427 | Extends => Extended_Project, | |
1428 | Packages_To_Check => Packages_To_Check); | |
1429 | Set_Project_Declaration_Of (Project, In_Tree, Project_Declaration); | |
fbf5a39b AC |
1430 | |
1431 | if Extended_Project /= Empty_Node then | |
1432 | Set_Extending_Project_Of | |
7e98a4c6 VC |
1433 | (Project_Declaration_Of (Extended_Project, In_Tree), In_Tree, |
1434 | To => Project); | |
fbf5a39b | 1435 | end if; |
19235870 RK |
1436 | end; |
1437 | ||
fbf5a39b | 1438 | Expect (Tok_End, "END"); |
c45b6ae0 | 1439 | Remove_Next_End_Node; |
19235870 | 1440 | |
fbf5a39b | 1441 | -- Skip "end" if present |
19235870 RK |
1442 | |
1443 | if Token = Tok_End then | |
7e98a4c6 | 1444 | Scan (In_Tree); |
19235870 RK |
1445 | end if; |
1446 | ||
fbf5a39b AC |
1447 | -- Clear the Buffer |
1448 | ||
1449 | Buffer_Last := 0; | |
19235870 | 1450 | |
fbf5a39b AC |
1451 | -- Store the name following "end" in the Buffer. The name may be made of |
1452 | -- several simple names. | |
19235870 | 1453 | |
fbf5a39b AC |
1454 | loop |
1455 | Expect (Tok_Identifier, "identifier"); | |
1456 | ||
1457 | -- If we don't have an identifier, clear the buffer before exiting to | |
1458 | -- avoid checking the name. | |
1459 | ||
1460 | if Token /= Tok_Identifier then | |
1461 | Buffer_Last := 0; | |
1462 | exit; | |
1463 | end if; | |
1464 | ||
1465 | -- Add the identifier to the Buffer | |
1466 | Get_Name_String (Token_Name); | |
7e98a4c6 | 1467 | Add_To_Buffer (Name_Buffer (1 .. Name_Len), Buffer, Buffer_Last); |
fbf5a39b AC |
1468 | |
1469 | -- Scan past the identifier | |
19235870 | 1470 | |
7e98a4c6 | 1471 | Scan (In_Tree); |
fbf5a39b | 1472 | exit when Token /= Tok_Dot; |
7e98a4c6 VC |
1473 | Add_To_Buffer (".", Buffer, Buffer_Last); |
1474 | Scan (In_Tree); | |
fbf5a39b AC |
1475 | end loop; |
1476 | ||
1477 | -- If we have a valid name, check if it is the name of the project | |
1478 | ||
1479 | if Name_Of_Project /= No_Name and then Buffer_Last > 0 then | |
1480 | if To_Lower (Buffer (1 .. Buffer_Last)) /= | |
7e98a4c6 | 1481 | Get_Name_String (Name_Of (Project, In_Tree)) |
19235870 | 1482 | then |
fbf5a39b AC |
1483 | -- Invalid name: report an error |
1484 | ||
a493557f | 1485 | Error_Msg ("expected """ & |
7e98a4c6 | 1486 | Get_Name_String (Name_Of (Project, In_Tree)) & """", |
19235870 RK |
1487 | Token_Ptr); |
1488 | end if; | |
1489 | end if; | |
1490 | ||
fbf5a39b AC |
1491 | Expect (Tok_Semicolon, "`;`"); |
1492 | ||
1493 | -- Check that there is no more text following the end of the project | |
1494 | -- source. | |
1495 | ||
1496 | if Token = Tok_Semicolon then | |
c45b6ae0 | 1497 | Set_Previous_End_Node (Project); |
7e98a4c6 | 1498 | Scan (In_Tree); |
19235870 | 1499 | |
fbf5a39b AC |
1500 | if Token /= Tok_EOF then |
1501 | Error_Msg | |
a493557f | 1502 | ("unexpected text following end of project", Token_Ptr); |
fbf5a39b AC |
1503 | end if; |
1504 | end if; | |
19235870 RK |
1505 | |
1506 | -- Restore the scan state, in case we are not the main project | |
1507 | ||
1508 | Restore_Project_Scan_State (Project_Scan_State); | |
1509 | ||
fbf5a39b AC |
1510 | -- And remove the project from the project stack |
1511 | ||
19235870 | 1512 | Project_Stack.Decrement_Last; |
c45b6ae0 AC |
1513 | |
1514 | -- Indicate if there are unkept comments | |
1515 | ||
1516 | Tree.Set_Project_File_Includes_Unkept_Comments | |
7e98a4c6 VC |
1517 | (Node => Project, |
1518 | In_Tree => In_Tree, | |
1519 | To => Tree.There_Are_Unkept_Comments); | |
c45b6ae0 AC |
1520 | |
1521 | -- And restore the comment state that was saved | |
1522 | ||
1523 | Tree.Restore (Project_Comment_State); | |
19235870 RK |
1524 | end Parse_Single_Project; |
1525 | ||
19235870 RK |
1526 | ----------------------- |
1527 | -- Project_Name_From -- | |
1528 | ----------------------- | |
1529 | ||
1530 | function Project_Name_From (Path_Name : String) return Name_Id is | |
1531 | Canonical : String (1 .. Path_Name'Length) := Path_Name; | |
fbf5a39b AC |
1532 | First : Natural := Canonical'Last; |
1533 | Last : Natural := First; | |
1534 | Index : Positive; | |
19235870 RK |
1535 | |
1536 | begin | |
fbf5a39b AC |
1537 | if Current_Verbosity = High then |
1538 | Write_Str ("Project_Name_From ("""); | |
1539 | Write_Str (Canonical); | |
1540 | Write_Line (""")"); | |
1541 | end if; | |
1542 | ||
1543 | -- If the path name is empty, return No_Name to indicate failure | |
1544 | ||
19235870 RK |
1545 | if First = 0 then |
1546 | return No_Name; | |
1547 | end if; | |
1548 | ||
1549 | Canonical_Case_File_Name (Canonical); | |
1550 | ||
fbf5a39b AC |
1551 | -- Look for the last dot in the path name |
1552 | ||
19235870 RK |
1553 | while First > 0 |
1554 | and then | |
1555 | Canonical (First) /= '.' | |
1556 | loop | |
1557 | First := First - 1; | |
1558 | end loop; | |
1559 | ||
fbf5a39b AC |
1560 | -- If we have a dot, check that it is followed by the correct extension |
1561 | ||
1562 | if First > 0 and then Canonical (First) = '.' then | |
19235870 RK |
1563 | if Canonical (First .. Last) = Project_File_Extension |
1564 | and then First /= 1 | |
1565 | then | |
fbf5a39b AC |
1566 | -- Look for the last directory separator, if any |
1567 | ||
19235870 RK |
1568 | First := First - 1; |
1569 | Last := First; | |
1570 | ||
1571 | while First > 0 | |
1572 | and then Canonical (First) /= '/' | |
1573 | and then Canonical (First) /= Dir_Sep | |
1574 | loop | |
1575 | First := First - 1; | |
1576 | end loop; | |
1577 | ||
1578 | else | |
fbf5a39b AC |
1579 | -- Not the correct extension, return No_Name to indicate failure |
1580 | ||
19235870 RK |
1581 | return No_Name; |
1582 | end if; | |
1583 | ||
fbf5a39b AC |
1584 | -- If no dot in the path name, return No_Name to indicate failure |
1585 | ||
19235870 RK |
1586 | else |
1587 | return No_Name; | |
1588 | end if; | |
1589 | ||
fbf5a39b AC |
1590 | First := First + 1; |
1591 | ||
1592 | -- If the extension is the file name, return No_Name to indicate failure | |
1593 | ||
1594 | if First > Last then | |
1595 | return No_Name; | |
19235870 RK |
1596 | end if; |
1597 | ||
fbf5a39b AC |
1598 | -- Put the name in lower case into Name_Buffer |
1599 | ||
19235870 RK |
1600 | Name_Len := Last - First + 1; |
1601 | Name_Buffer (1 .. Name_Len) := To_Lower (Canonical (First .. Last)); | |
1602 | ||
fbf5a39b | 1603 | Index := 1; |
19235870 | 1604 | |
fbf5a39b AC |
1605 | -- Check if it is a well formed project name. Return No_Name if it is |
1606 | -- ill formed. | |
1607 | ||
1608 | loop | |
1609 | if not Is_Letter (Name_Buffer (Index)) then | |
1610 | return No_Name; | |
1611 | ||
1612 | else | |
1613 | loop | |
1614 | Index := Index + 1; | |
1615 | ||
1616 | exit when Index >= Name_Len; | |
1617 | ||
1618 | if Name_Buffer (Index) = '_' then | |
1619 | if Name_Buffer (Index + 1) = '_' then | |
1620 | return No_Name; | |
1621 | end if; | |
1622 | end if; | |
1623 | ||
1624 | exit when Name_Buffer (Index) = '-'; | |
1625 | ||
1626 | if Name_Buffer (Index) /= '_' | |
1627 | and then not Is_Alphanumeric (Name_Buffer (Index)) | |
1628 | then | |
19235870 RK |
1629 | return No_Name; |
1630 | end if; | |
1631 | ||
fbf5a39b AC |
1632 | end loop; |
1633 | end if; | |
19235870 | 1634 | |
fbf5a39b AC |
1635 | if Index >= Name_Len then |
1636 | if Is_Alphanumeric (Name_Buffer (Name_Len)) then | |
19235870 | 1637 | |
fbf5a39b | 1638 | -- All checks have succeeded. Return name in Name_Buffer |
19235870 | 1639 | |
fbf5a39b | 1640 | return Name_Find; |
19235870 | 1641 | |
fbf5a39b AC |
1642 | else |
1643 | return No_Name; | |
1644 | end if; | |
1645 | ||
1646 | elsif Name_Buffer (Index) = '-' then | |
1647 | Index := Index + 1; | |
1648 | end if; | |
1649 | end loop; | |
19235870 RK |
1650 | end Project_Name_From; |
1651 | ||
1652 | -------------------------- | |
1653 | -- Project_Path_Name_Of -- | |
1654 | -------------------------- | |
1655 | ||
1656 | function Project_Path_Name_Of | |
1657 | (Project_File_Name : String; | |
2820d220 | 1658 | Directory : String) return String |
19235870 RK |
1659 | is |
1660 | Result : String_Access; | |
1661 | ||
1662 | begin | |
19235870 RK |
1663 | if Current_Verbosity = High then |
1664 | Write_Str ("Project_Path_Name_Of ("""); | |
1665 | Write_Str (Project_File_Name); | |
1666 | Write_Str (""", """); | |
1667 | Write_Str (Directory); | |
1668 | Write_Line (""");"); | |
19235870 RK |
1669 | end if; |
1670 | ||
fbf5a39b AC |
1671 | if not Is_Absolute_Path (Project_File_Name) then |
1672 | -- First we try <directory>/<file_name>.<extension> | |
19235870 | 1673 | |
19235870 RK |
1674 | if Current_Verbosity = High then |
1675 | Write_Str (" Trying "); | |
fbf5a39b AC |
1676 | Write_Str (Directory); |
1677 | Write_Char (Directory_Separator); | |
1678 | Write_Str (Project_File_Name); | |
1679 | Write_Line (Project_File_Extension); | |
19235870 RK |
1680 | end if; |
1681 | ||
1682 | Result := | |
1683 | Locate_Regular_File | |
fbf5a39b AC |
1684 | (File_Name => Directory & Directory_Separator & |
1685 | Project_File_Name & Project_File_Extension, | |
44e1918a | 1686 | Path => Project_Path); |
19235870 | 1687 | |
fbf5a39b | 1688 | -- Then we try <directory>/<file_name> |
19235870 RK |
1689 | |
1690 | if Result = null then | |
1691 | if Current_Verbosity = High then | |
1692 | Write_Str (" Trying "); | |
1693 | Write_Str (Directory); | |
fbf5a39b AC |
1694 | Write_Char (Directory_Separator); |
1695 | Write_Line (Project_File_Name); | |
19235870 RK |
1696 | end if; |
1697 | ||
1698 | Result := | |
1699 | Locate_Regular_File | |
fbf5a39b AC |
1700 | (File_Name => Directory & Directory_Separator & |
1701 | Project_File_Name, | |
44e1918a | 1702 | Path => Project_Path); |
fbf5a39b AC |
1703 | end if; |
1704 | end if; | |
19235870 | 1705 | |
fbf5a39b | 1706 | if Result = null then |
19235870 | 1707 | |
fbf5a39b | 1708 | -- Then we try <file_name>.<extension> |
19235870 | 1709 | |
fbf5a39b AC |
1710 | if Current_Verbosity = High then |
1711 | Write_Str (" Trying "); | |
1712 | Write_Str (Project_File_Name); | |
1713 | Write_Line (Project_File_Extension); | |
19235870 | 1714 | end if; |
fbf5a39b AC |
1715 | |
1716 | Result := | |
1717 | Locate_Regular_File | |
1718 | (File_Name => Project_File_Name & Project_File_Extension, | |
44e1918a | 1719 | Path => Project_Path); |
fbf5a39b AC |
1720 | end if; |
1721 | ||
1722 | if Result = null then | |
1723 | ||
1724 | -- Then we try <file_name> | |
1725 | ||
1726 | if Current_Verbosity = High then | |
1727 | Write_Str (" Trying "); | |
1728 | Write_Line (Project_File_Name); | |
1729 | end if; | |
1730 | ||
1731 | Result := | |
1732 | Locate_Regular_File | |
1733 | (File_Name => Project_File_Name, | |
44e1918a | 1734 | Path => Project_Path); |
19235870 RK |
1735 | end if; |
1736 | ||
1737 | -- If we cannot find the project file, we return an empty string | |
1738 | ||
1739 | if Result = null then | |
1740 | return ""; | |
1741 | ||
1742 | else | |
1743 | declare | |
5c1c8a03 | 1744 | Final_Result : constant String := |
6d11af89 AC |
1745 | GNAT.OS_Lib.Normalize_Pathname |
1746 | (Result.all, | |
1747 | Resolve_Links => False, | |
1748 | Case_Sensitive => True); | |
19235870 RK |
1749 | begin |
1750 | Free (Result); | |
19235870 RK |
1751 | return Final_Result; |
1752 | end; | |
19235870 | 1753 | end if; |
19235870 RK |
1754 | end Project_Path_Name_Of; |
1755 | ||
19235870 | 1756 | end Prj.Part; |