?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
Daily bump.
[official-gcc.git] / gcc / ada / prj-part.adb
blobc4cf2da8c886f207c36ca746cb56f5c28ff4f595
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- P R J . P A R T --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2001-2014, Free Software Foundation, Inc. --
10 -- --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
20 -- --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
23 -- --
24 ------------------------------------------------------------------------------
25
26 with Atree; use Atree;
27 with Err_Vars; use Err_Vars;
28 with Opt; use Opt;
29 with Osint; use Osint;
30 with Output; use Output;
31 with Prj.Com; use Prj.Com;
32 with Prj.Dect;
33 with Prj.Env; use Prj.Env;
34 with Prj.Err; use Prj.Err;
35 with Sinput; use Sinput;
36 with Sinput.P; use Sinput.P;
37 with Snames;
38 with Table;
39
40 with Ada.Characters.Handling; use Ada.Characters.Handling;
41 with Ada.Exceptions; use Ada.Exceptions;
42
43 with GNAT.HTable; use GNAT.HTable;
44
45 package body Prj.Part is
46
47 Buffer : String_Access;
48 Buffer_Last : Natural := 0;
49
50 Dir_Sep : Character renames GNAT.OS_Lib.Directory_Separator;
51
52 ------------------------------------
53 -- Local Packages and Subprograms --
54 ------------------------------------
55
56 type With_Id is new Nat;
57 No_With : constant With_Id := 0;
58
59 type With_Record is record
60 Path : Path_Name_Type;
61 Location : Source_Ptr;
62 Limited_With : Boolean;
63 Node : Project_Node_Id;
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,
73 Table_Increment => 100,
74 Table_Name => "Prj.Part.Withs");
75 -- Table used to store temporarily paths and locations of imported
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.
80
81 type Names_And_Id is record
82 Path_Name : Path_Name_Type;
83 Canonical_Path_Name : Path_Name_Type;
84 Id : Project_Node_Id;
85 Limited_With : Boolean;
86 end record;
87
88 package Project_Stack is new Table.Table
89 (Table_Component_Type => Names_And_Id,
90 Table_Index_Type => Nat,
91 Table_Low_Bound => 1,
92 Table_Initial => 10,
93 Table_Increment => 100,
94 Table_Name => "Prj.Part.Project_Stack");
95 -- This table is used to detect circular dependencies
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
100 package Virtual_Hash is new GNAT.HTable.Simple_HTable
101 (Header_Num => Header_Num,
102 Element => Project_Node_Id,
103 No_Element => Project_Node_High_Bound,
104 Key => Project_Node_Id,
105 Hash => Prj.Tree.Hash,
106 Equal => "=");
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.
112
113 package Processed_Hash is new GNAT.HTable.Simple_HTable
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
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
139 -- Hash table to cache project path to avoid looking for them on the path
140
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
154 procedure Check_Import_Aggregate
155 (Flags : Processing_Flags;
156 In_Tree : Project_Node_Tree_Ref;
157 Project : Project_Node_Id);
158 -- Check that a non aggregate project does not import an aggregate project
159
160 procedure Create_Virtual_Extending_Project
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);
165 -- Create a virtual extending project of For_Project. Main_Project is
166 -- the extending all project. Extension_Withs is the head of a WITH clause
167 -- list to be added to the created virtual project.
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.
172
173 procedure Look_For_Virtual_Projects_For
174 (Proj : Project_Node_Id;
175 In_Tree : Project_Node_Tree_Ref;
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
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;
192 Path_Name_Id : Path_Name_Type;
193 Extended : Boolean;
194 From_Extended : Extension_Origin;
195 In_Limited : Boolean;
196 Packages_To_Check : String_List_Access;
197 Depth : Natural;
198 Current_Dir : String;
199 Is_Config_File : Boolean;
200 Env : in out Environment;
201 Implicit_Project : Boolean := False);
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.
208 --
209 -- Is_Config_File should be set to True if the project represents a config
210 -- file (.cgpr) since some specific checks apply.
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.
215
216 procedure Pre_Parse_Context_Clause
217 (In_Tree : Project_Node_Tree_Ref;
218 Context_Clause : out With_Id;
219 Is_Config_File : Boolean;
220 Flags : Processing_Flags);
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").
225 -- Is_Config_File should be set to True if the project represents a config
226 -- file (.cgpr) since some specific checks apply.
227
228 procedure Post_Parse_Context_Clause
229 (Context_Clause : With_Id;
230 In_Tree : Project_Node_Tree_Ref;
231 In_Limited : Boolean;
232 Limited_Withs : Boolean;
233 Imported_Projects : in out Project_Node_Id;
234 Project_Directory : Path_Name_Type;
235 From_Extended : Extension_Origin;
236 Packages_To_Check : String_List_Access;
237 Depth : Natural;
238 Current_Dir : String;
239 Is_Config_File : Boolean;
240 Env : in out Environment);
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.
243 --
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.
248 --
249 -- Is_Config_File should be set to True if the project represents a config
250 -- file (.cgpr) since some specific checks apply.
251
252 function Project_Name_From
253 (Path_Name : String;
254 Is_Config_File : Boolean) return Name_Id;
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
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
289 --------------------------------------
290 -- Create_Virtual_Extending_Project --
291 --------------------------------------
292
293 procedure Create_Virtual_Extending_Project
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)
298 is
299
300 Virtual_Name : constant String :=
301 Virtual_Prefix &
302 Get_Name_String (Name_Of (For_Project, In_Tree));
303 -- The name of the virtual extending project
304
305 Virtual_Name_Id : Name_Id;
306 -- Virtual extending project name id
307
308 Virtual_Path_Id : Path_Name_Type;
309 -- Fake path name of the virtual extending project. The directory is
310 -- the same directory as the extending all project.
311
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
325 Virtual_Project : Project_Node_Id;
326 With_Clause : constant Project_Node_Id :=
327 Default_Project_Node
328 (In_Tree, N_With_Clause);
329 Project_Declaration : Project_Node_Id;
330 Source_Dirs_Declaration : constant Project_Node_Id :=
331 Default_Project_Node
332 (In_Tree, N_Declarative_Item);
333 Source_Dirs_Attribute : constant Project_Node_Id :=
334 Default_Project_Node
335 (In_Tree, N_Attribute_Declaration, List);
336 Source_Dirs_Expression : constant Project_Node_Id :=
337 Default_Project_Node
338 (In_Tree, N_Expression, List);
339 Source_Dirs_Term : constant Project_Node_Id :=
340 Default_Project_Node
341 (In_Tree, N_Term, List);
342 Source_Dirs_List : constant Project_Node_Id :=
343 Default_Project_Node
344 (In_Tree, N_Literal_String_List, List);
345
346 begin
347 -- Get the virtual path name
348
349 Get_Name_String (Path_Name_Of (Main_Project, In_Tree));
350
351 while Name_Len > 0
352 and then not Is_Directory_Separator (Name_Buffer (Name_Len))
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
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
376 -- Add a WITH clause to the main project to import the newly created
377 -- virtual extending project.
378
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);
382 Set_Next_With_Clause_Of
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);
385
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;
391
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;
399
400 Set_First_With_Clause_Of (Virtual_Project, In_Tree, New_With_Clause);
401 end;
402
403 -- Virtual project node
404
405 Set_Location_Of
406 (Virtual_Project, In_Tree, Location_Of (Main_Project, In_Tree));
407 Set_Extended_Project_Path_Of
408 (Virtual_Project, In_Tree, Path_Name_Of (For_Project, In_Tree));
409
410 -- Project declaration
411
412 Set_First_Declarative_Item_Of
413 (Project_Declaration, In_Tree, Source_Dirs_Declaration);
414 Set_Extended_Project_Of (Project_Declaration, In_Tree, For_Project);
415
416 -- Source_Dirs declaration
417
418 Set_Current_Item_Node
419 (Source_Dirs_Declaration, In_Tree, Source_Dirs_Attribute);
420
421 -- Source_Dirs attribute
422
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);
426
427 -- Source_Dirs expression
428
429 Set_First_Term (Source_Dirs_Expression, In_Tree, Source_Dirs_Term);
430
431 -- Source_Dirs term
432
433 Set_Current_Term (Source_Dirs_Term, In_Tree, Source_Dirs_List);
434
435 -- Source_Dirs empty list: nothing to do
436 end Create_Virtual_Extending_Project;
437
438 -----------------------------------
439 -- Look_For_Virtual_Projects_For --
440 -----------------------------------
441
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
450 procedure Look_For_Virtual_Projects_For
451 (Proj : Project_Node_Id;
452 In_Tree : Project_Node_Tree_Ref;
453 Potentially_Virtual : Boolean)
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
461 Imported : Project_Node_Id := Empty_Node;
462 -- Node for a project imported by Proj
463
464 Extended : Project_Node_Id := Empty_Node;
465 -- Node for the eventual project extended by Proj
466
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
472 begin
473 -- Nothing to do if Proj is undefined or has already been processed
474
475 if Present (Proj) and then not Processed_Hash.Get (Proj) then
476
477 -- Make sure the project will not be processed again
478
479 Processed_Hash.Set (Proj, True);
480
481 Declaration := Project_Declaration_Of (Proj, In_Tree);
482
483 if Present (Declaration) then
484 Extended := Extended_Project_Of (Declaration, In_Tree);
485 Extends_All := Is_Extending_All (Proj, In_Tree);
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
491 if Potentially_Virtual and then No (Extended) then
492 Virtual_Hash.Set (Proj, Extension_Withs);
493 end if;
494
495 -- Now check the projects it imports
496
497 With_Clause := First_With_Clause_Of (Proj, In_Tree);
498 while Present (With_Clause) loop
499 Imported := Project_Node_Of (With_Clause, In_Tree);
500
501 if Present (Imported) then
502 Look_For_Virtual_Projects_For
503 (Imported, In_Tree, Potentially_Virtual => True);
504 end if;
505
506 if Extends_All then
507
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
515 With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
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
523 (Extended, In_Tree, Potentially_Virtual => False);
524
525 Extension_Withs := Saved_Extension_Withs;
526 end if;
527 end Look_For_Virtual_Projects_For;
528
529 -----------
530 -- Parse --
531 -----------
532
533 procedure Parse
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;
538 Packages_To_Check : String_List_Access;
539 Store_Comments : Boolean := False;
540 Current_Directory : String := "";
541 Is_Config_File : Boolean;
542 Env : in out Prj.Tree.Environment;
543 Target_Name : String := "";
544 Implicit_Project : Boolean := False)
545 is
546 Dummy : Boolean;
547 pragma Warnings (Off, Dummy);
548
549 Real_Project_File_Name : String_Access :=
550 Osint.To_Canonical_File_Spec
551 (Project_File_Name);
552 Path_Name_Id : Path_Name_Type;
553
554 begin
555 In_Tree.Incomplete_With := False;
556 Project_Stack.Init;
557 Tree_Private_Part.Projects_Htable.Reset (In_Tree.Projects_HT);
558
559 if not Is_Initialized (Env.Project_Path) then
560 Prj.Env.Initialize_Default_Project_Path
561 (Env.Project_Path, Target_Name);
562 end if;
563
564 if Real_Project_File_Name = null then
565 Real_Project_File_Name := new String'(Project_File_Name);
566 end if;
567
568 Project := Empty_Node;
569
570 Find_Project (Env.Project_Path,
571 Project_File_Name => Real_Project_File_Name.all,
572 Directory => Current_Directory,
573 Path => Path_Name_Id);
574 Free (Real_Project_File_Name);
575
576 if Errout_Handling /= Never_Finalize then
577 Prj.Err.Initialize;
578 end if;
579
580 Prj.Err.Scanner.Set_Comment_As_Token (Store_Comments);
581 Prj.Err.Scanner.Set_End_Of_Line_As_Token (Store_Comments);
582
583 if Path_Name_Id = No_Path then
584 declare
585 P : String_Access;
586 begin
587 Get_Path (Env.Project_Path, Path => P);
588
589 Prj.Com.Fail
590 ("project file """
591 & Project_File_Name
592 & """ not found in "
593 & P.all);
594 Project := Empty_Node;
595 return;
596 end;
597 end if;
598
599 -- Parse the main project file
600
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,
614 Env => Env,
615 Implicit_Project => Implicit_Project);
616
617 exception
618 when Types.Unrecoverable_Error =>
619
620 -- Unrecoverable_Error is raised when a line is too long.
621 -- A meaningful error message will be displayed later.
622
623 Project := Empty_Node;
624 end;
625
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.
629
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.
635
636 Virtual_Hash.Reset;
637 Processed_Hash.Reset;
638
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.
642
643 Processed_Hash.Set (Project, True);
644
645 declare
646 Declaration : constant Project_Node_Id :=
647 Project_Declaration_Of (Project, In_Tree);
648 begin
649 Extension_Withs := First_With_Clause_Of (Project, In_Tree);
650 Look_For_Virtual_Projects_For
651 (Extended_Project_Of (Declaration, In_Tree), In_Tree,
652 Potentially_Virtual => False);
653 end;
654
655 -- Now, check the projects directly imported by the main project.
656 -- Remove from the potentially virtual any project extended by one
657 -- of these imported projects.
658
659 declare
660 With_Clause : Project_Node_Id;
661 Imported : Project_Node_Id := Empty_Node;
662 Declaration : Project_Node_Id := Empty_Node;
663
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);
668
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;
683 end if;
684 end if;
685
686 With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
687 end loop;
688 end;
689
690 -- Now create all the virtual extending projects
691
692 declare
693 Proj : Project_Node_Id := Empty_Node;
694 Withs : Project_Node_Id;
695 begin
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);
701 end loop;
702 end;
703 end if;
704
705 -- If there were any kind of error during the parsing, serious
706 -- or not, then the parsing fails.
707
708 if Total_Errors_Detected > 0 then
709 Project := Empty_Node;
710 end if;
711
712 case Errout_Handling is
713 when Always_Finalize =>
714 Prj.Err.Finalize;
715
716 -- Reinitialize to avoid duplicate warnings later on
717 Prj.Err.Initialize;
718
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;
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
741 ------------------------------
742 -- Pre_Parse_Context_Clause --
743 ------------------------------
744
745 procedure Pre_Parse_Context_Clause
746 (In_Tree : Project_Node_Tree_Ref;
747 Context_Clause : out With_Id;
748 Is_Config_File : Boolean;
749 Flags : Processing_Flags)
750 is
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;
755
756 begin
757 -- Assume no context clause
758
759 Context_Clause := No_With;
760 With_Loop :
761
762 -- If Token is not WITH or LIMITED, there is no context clause, or we
763 -- have exhausted the with clauses.
764
765 while Token = Tok_With or else Token = Tok_Limited loop
766 Current_With_Node :=
767 Default_Project_Node (Of_Kind => N_With_Clause, In_Tree => In_Tree);
768 Limited_With := Token = Tok_Limited;
769
770 if Is_Config_File then
771 Error_Msg
772 (Flags,
773 "configuration project cannot import " &
774 "other configuration projects",
775 Token_Ptr);
776 end if;
777
778 if Limited_With then
779 Scan (In_Tree); -- past LIMITED
780 Expect (Tok_With, "WITH");
781 exit With_Loop when Token /= Tok_With;
782 end if;
783
784 Comma_Loop :
785 loop
786 Scan (In_Tree); -- past WITH or ","
787
788 Expect (Tok_String_Literal, "literal string");
789
790 if Token /= Tok_String_Literal then
791 return;
792 end if;
793
794 -- Store path and location in table Withs
795
796 Current_With :=
797 (Path => Path_Name_Type (Token_Name),
798 Location => Token_Ptr,
799 Limited_With => Limited_With,
800 Node => Current_With_Node,
801 Next => No_With);
802
803 Withs.Increment_Last;
804 Withs.Table (Withs.Last) := Current_With;
805
806 if Current_With_Clause = No_With then
807 Context_Clause := Withs.Last;
808
809 else
810 Withs.Table (Current_With_Clause).Next := Withs.Last;
811 end if;
812
813 Current_With_Clause := Withs.Last;
814
815 Scan (In_Tree);
816
817 if Token = Tok_Semicolon then
818 Set_End_Of_Line (Current_With_Node);
819 Set_Previous_Line_Node (Current_With_Node);
820
821 -- End of (possibly multiple) with clause;
822
823 Scan (In_Tree); -- past semicolon
824 exit Comma_Loop;
825
826 elsif Token = Tok_Comma then
827 Set_Is_Not_Last_In_List (Current_With_Node, In_Tree);
828
829 else
830 Error_Msg (Flags, "expected comma or semi colon", Token_Ptr);
831 exit Comma_Loop;
832 end if;
833
834 Current_With_Node :=
835 Default_Project_Node
836 (Of_Kind => N_With_Clause, In_Tree => In_Tree);
837 end loop Comma_Loop;
838 end loop With_Loop;
839 end Pre_Parse_Context_Clause;
840
841 -------------------------------
842 -- Post_Parse_Context_Clause --
843 -------------------------------
844
845 procedure Post_Parse_Context_Clause
846 (Context_Clause : With_Id;
847 In_Tree : Project_Node_Tree_Ref;
848 In_Limited : Boolean;
849 Limited_Withs : Boolean;
850 Imported_Projects : in out Project_Node_Id;
851 Project_Directory : Path_Name_Type;
852 From_Extended : Extension_Origin;
853 Packages_To_Check : String_List_Access;
854 Depth : Natural;
855 Current_Dir : String;
856 Is_Config_File : Boolean;
857 Env : in out Environment)
858 is
859 Current_With_Clause : With_Id := Context_Clause;
860
861 Current_Project : Project_Node_Id := Imported_Projects;
862 Previous_Project : Project_Node_Id := Empty_Node;
863 Next_Project : Project_Node_Id := Empty_Node;
864
865 Project_Directory_Path : constant String :=
866 Get_Name_String (Project_Directory);
867
868 Current_With : With_Record;
869 Extends_All : Boolean := False;
870 Imported_Path_Name_Id : Path_Name_Type;
871
872 begin
873 -- Set Current_Project to the last project in the current list, if the
874 -- list is not empty.
875
876 if Present (Current_Project) then
877 while
878 Present (Next_With_Clause_Of (Current_Project, In_Tree))
879 loop
880 Current_Project := Next_With_Clause_Of (Current_Project, In_Tree);
881 end loop;
882 end if;
883
884 while Current_With_Clause /= No_With loop
885 Current_With := Withs.Table (Current_With_Clause);
886 Current_With_Clause := Current_With.Next;
887
888 if Limited_Withs = Current_With.Limited_With then
889 Find_Project
890 (Env.Project_Path,
891 Project_File_Name => Get_Name_String (Current_With.Path),
892 Directory => Project_Directory_Path,
893 Path => Imported_Path_Name_Id);
894
895 if Imported_Path_Name_Id = No_Path then
896 if Env.Flags.Ignore_Missing_With then
897 In_Tree.Incomplete_With := True;
898 Env.Flags.Incomplete_Withs := True;
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;
920 end if;
921
922 else
923 -- New with clause
924
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);
933
934 Withed_Project : Project_Node_Id := Empty_Node;
935
936 begin
937 Previous_Project := Current_Project;
938
939 if No (Current_Project) then
940
941 -- First with clause of the context clause
942
943 Current_Project := Current_With.Node;
944 Imported_Projects := Current_Project;
945
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;
952
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
964 if (In_Limited or Limited_Withs)
965 and then Project_Stack.Last > 1
966 then
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.
982
983 Withed_Project := Project_Stack.Table (Index).Id;
984 exit;
985 end if;
986 end loop;
987 end;
988 end if;
989
990 -- Parse the imported project if its project id is unknown
991
992 if No (Withed_Project) then
993 Parse_Single_Project
994 (In_Tree => In_Tree,
995 Project => Withed_Project,
996 Extends_All => Extends_All,
997 Path_Name_Id => Imported_Path_Name_Id,
998 Extended => False,
999 From_Extended => From_Extended,
1000 In_Limited => In_Limited or Limited_Withs,
1001 Packages_To_Check => Packages_To_Check,
1002 Depth => Depth,
1003 Current_Dir => Current_Dir,
1004 Is_Config_File => Is_Config_File,
1005 Env => Env);
1006
1007 else
1008 Extends_All := Is_Extending_All (Withed_Project, In_Tree);
1009 end if;
1010
1011 if No (Withed_Project) then
1012
1013 -- If parsing unsuccessful, remove the context clause
1014
1015 Current_Project := Previous_Project;
1016
1017 if No (Current_Project) then
1018 Imported_Projects := Empty_Node;
1019
1020 else
1021 Set_Next_With_Clause_Of
1022 (Current_Project, In_Tree, Empty_Node);
1023 end if;
1024 else
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));
1037
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);
1041
1042 if Extends_All then
1043 Set_Is_Extending_All (Current_Project, In_Tree);
1044 end if;
1045 end if;
1046 end;
1047 end if;
1048 end if;
1049 end loop;
1050 end Post_Parse_Context_Clause;
1051
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
1061 With_Clause : Project_Node_Id;
1062 Imported : Project_Node_Id;
1063
1064 begin
1065 if not Is_Extending_All (Project, In_Tree) then
1066 With_Clause := First_With_Clause_Of (Project, In_Tree);
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
1099 if Project_Qualifier_Of (Imported, In_Tree) /= Abstract_Project
1100 then
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
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
1121 With_Clause : Project_Node_Id;
1122 Imported : Project_Node_Id;
1123
1124 begin
1125 if Project_Qualifier_Of (Project, In_Tree) /= Aggregate then
1126 With_Clause := First_With_Clause_Of (Project, In_Tree);
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));
1132 Error_Msg
1133 (Flags, "cannot import aggregate project %%", Token_Ptr);
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
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
1158 Proj_Qualifier := Abstract_Project;
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
1171 if Token = Tok_Identifier
1172 and then Token_Name = Snames.Name_Library
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
1263 --------------------------
1264 -- Parse_Single_Project --
1265 --------------------------
1266
1267 procedure Parse_Single_Project
1268 (In_Tree : Project_Node_Tree_Ref;
1269 Project : out Project_Node_Id;
1270 Extends_All : out Boolean;
1271 Path_Name_Id : Path_Name_Type;
1272 Extended : Boolean;
1273 From_Extended : Extension_Origin;
1274 In_Limited : Boolean;
1275 Packages_To_Check : String_List_Access;
1276 Depth : Natural;
1277 Current_Dir : String;
1278 Is_Config_File : Boolean;
1279 Env : in out Environment;
1280 Implicit_Project : Boolean := False)
1281 is
1282 Path_Name : constant String := Get_Name_String (Path_Name_Id);
1283
1284 Normed_Path_Name : Path_Name_Type;
1285 Canonical_Path_Name : Path_Name_Type;
1286 Resolved_Path_Name : Path_Name_Type;
1287 Project_Directory : Path_Name_Type;
1288 Project_Scan_State : Saved_Project_Scan_State;
1289 Source_Index : Source_File_Index;
1290
1291 Extending : Boolean := False;
1292
1293 Extended_Project : Project_Node_Id := Empty_Node;
1294
1295 A_Project_Name_And_Node : Tree_Private_Part.Project_Name_And_Node :=
1296 Tree_Private_Part.Projects_Htable.Get_First
1297 (In_Tree.Projects_HT);
1298
1299 Name_From_Path : constant Name_Id :=
1300 Project_Name_From (Path_Name, Is_Config_File => Is_Config_File);
1301 Name_Of_Project : Name_Id := No_Name;
1302
1303 Duplicated : Boolean := False;
1304
1305 First_With : With_Id;
1306 Imported_Projects : Project_Node_Id := Empty_Node;
1307
1308 use Tree_Private_Part;
1309
1310 Project_Comment_State : Tree.Comment_State;
1311
1312 Qualifier_Location : Source_Ptr;
1313
1314 begin
1315 Extends_All := False;
1316
1317 declare
1318 Normed_Path : constant String := Normalize_Pathname
1319 (Path_Name,
1320 Directory => Current_Dir,
1321 Resolve_Links => False,
1322 Case_Sensitive => True);
1323 Canonical_Path : constant String := Normalize_Pathname
1324 (Normed_Path,
1325 Directory => Current_Dir,
1326 Resolve_Links => Opt.Follow_Links_For_Files,
1327 Case_Sensitive => False);
1328 begin
1329 Name_Len := Normed_Path'Length;
1330 Name_Buffer (1 .. Name_Len) := Normed_Path;
1331 Normed_Path_Name := Name_Find;
1332 Name_Len := Canonical_Path'Length;
1333 Name_Buffer (1 .. Name_Len) := Canonical_Path;
1334 Canonical_Path_Name := Name_Find;
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
1349 end;
1350
1351 if Has_Circular_Dependencies
1352 (Env.Flags, Normed_Path_Name, Canonical_Path_Name)
1353 then
1354 Project := Empty_Node;
1355 return;
1356 end if;
1357
1358 -- Put the new path name on the stack
1359
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));
1365
1366 -- Check if the project file has already been parsed
1367
1368 while
1369 A_Project_Name_And_Node /= Tree_Private_Part.No_Project_Name_And_Node
1370 loop
1371 if A_Project_Name_And_Node.Resolved_Path = Resolved_Path_Name then
1372 if Extended then
1373
1374 if A_Project_Name_And_Node.Extended then
1375 if A_Project_Name_And_Node.Proj_Qualifier /= Abstract_Project
1376 then
1377 Error_Msg
1378 (Env.Flags,
1379 "cannot extend the same project file several times",
1380 Token_Ptr);
1381 end if;
1382 elsif not A_Project_Name_And_Node.From_Extended then
1383 Error_Msg
1384 (Env.Flags,
1385 "cannot extend an already imported project file",
1386 Token_Ptr);
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);
1396 end if;
1397
1398 elsif A_Project_Name_And_Node.Extended then
1399 Extends_All :=
1400 Is_Extending_All (A_Project_Name_And_Node.Node, In_Tree);
1401
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.
1405
1406 if From_Extended /= None then
1407 declare
1408 Decl : Project_Node_Id :=
1409 Project_Declaration_Of
1410 (A_Project_Name_And_Node.Node, In_Tree);
1411
1412 Prj : Project_Node_Id :=
1413 A_Project_Name_And_Node.Node;
1414
1415 begin
1416 -- Loop through extending projects to find the ultimate
1417 -- extending project, that is the one that is not
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.
1422
1423 while
1424 Extending_Project_Of (Decl, In_Tree) /= Empty_Node
1425 loop
1426 Prj := Extending_Project_Of (Decl, In_Tree);
1427 Decl := Project_Declaration_Of (Prj, In_Tree);
1428 end loop;
1429
1430 A_Project_Name_And_Node.Node := Prj;
1431 end;
1432 else
1433 Error_Msg
1434 (Env.Flags,
1435 "cannot import an already extended project file",
1436 Token_Ptr);
1437 end if;
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);
1448 end if;
1449
1450 Project := A_Project_Name_And_Node.Node;
1451 Project_Stack.Decrement_Last;
1452 return;
1453 end if;
1454
1455 A_Project_Name_And_Node :=
1456 Tree_Private_Part.Projects_Htable.Get_Next (In_Tree.Projects_HT);
1457 end loop;
1458
1459 -- We never encountered this project file. Save the scan state, load the
1460 -- project file and start to scan it.
1461
1462 Save_Project_Scan_State (Project_Scan_State);
1463 Source_Index := Load_Project_File (Path_Name);
1464 Tree.Save (Project_Comment_State);
1465
1466 -- If we cannot find it, we stop
1467
1468 if Source_Index = No_Source_File then
1469 Project := Empty_Node;
1470 Project_Stack.Decrement_Last;
1471 return;
1472 end if;
1473
1474 Prj.Err.Scanner.Initialize_Scanner (Source_Index);
1475 Tree.Reset_State;
1476 Scan (In_Tree);
1477
1478 if not Is_Config_File
1479 and then Name_From_Path = No_Name
1480 and then not Implicit_Project
1481 then
1482
1483 -- The project file name is not correct (no or bad extension, or not
1484 -- following Ada identifier's syntax).
1485
1486 Error_Msg_File_1 := File_Name_Type (Canonical_Path_Name);
1487 Error_Msg (Env.Flags,
1488 "?{ is not a valid path name for a project file",
1489 Token_Ptr);
1490 end if;
1491
1492 if Current_Verbosity >= Medium then
1493 Debug_Increase_Indent ("Parsing """ & Path_Name & '"');
1494 end if;
1495
1496 Project_Directory :=
1497 Path_Name_Type (Get_Directory (File_Name_Type (Normed_Path_Name)));
1498
1499 -- Is there any imported project?
1500
1501 Pre_Parse_Context_Clause
1502 (In_Tree => In_Tree,
1503 Is_Config_File => Is_Config_File,
1504 Context_Clause => First_With,
1505 Flags => Env.Flags);
1506
1507 Project := Default_Project_Node
1508 (Of_Kind => N_Project, In_Tree => In_Tree);
1509 Project_Stack.Table (Project_Stack.Last).Id := Project;
1510 Set_Directory_Of (Project, In_Tree, Project_Directory);
1511 Set_Path_Name_Of (Project, In_Tree, Normed_Path_Name);
1512
1513 Read_Project_Qualifier
1514 (Env.Flags, In_Tree, Is_Config_File, Qualifier_Location, Project);
1515
1516 Set_Location_Of (Project, In_Tree, Token_Ptr);
1517
1518 Expect (Tok_Project, "PROJECT");
1519
1520 -- Mark location of PROJECT token if present
1521
1522 if Token = Tok_Project then
1523 Scan (In_Tree); -- past PROJECT
1524 Set_Location_Of (Project, In_Tree, Token_Ptr);
1525 end if;
1526
1527 -- Clear the Buffer
1528
1529 Buffer_Last := 0;
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
1542
1543 Get_Name_String (Token_Name);
1544 Add_To_Buffer (Name_Buffer (1 .. Name_Len), Buffer, Buffer_Last);
1545
1546 -- Scan past the identifier
1547
1548 Scan (In_Tree);
1549
1550 -- If we have a dot, add a dot to the Buffer and look for the next
1551 -- identifier.
1552
1553 exit when Token /= Tok_Dot;
1554 Add_To_Buffer (".", Buffer, Buffer_Last);
1555
1556 -- Scan past the dot
1557
1558 Scan (In_Tree);
1559 end loop;
1560
1561 -- See if this is an extending project
1562
1563 if Token = Tok_Extends then
1564
1565 if Is_Config_File then
1566 Error_Msg
1567 (Env.Flags,
1568 "extending configuration project not allowed", Token_Ptr);
1569 end if;
1570
1571 -- Make sure that gnatmake will use mapping files
1572
1573 Opt.Create_Mapping_File := True;
1574
1575 -- We are extending another project
1576
1577 Extending := True;
1578
1579 Scan (In_Tree); -- past EXTENDS
1580
1581 if Token = Tok_All then
1582 Extends_All := True;
1583 Set_Is_Extending_All (Project, In_Tree);
1584 Scan (In_Tree); -- scan past ALL
1585 end if;
1586 end if;
1587
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;
1597 Set_Name_Of (Project, In_Tree, Name_Of_Project);
1598
1599 -- To get expected name of the project file, replace dots by dashes
1600
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
1607 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1608
1609 declare
1610 Expected_Name : constant Name_Id := Name_Find;
1611 Extension : String_Access;
1612
1613 begin
1614 -- Output a warning if the actual name is not the expected name
1615
1616 if not Is_Config_File
1617 and then (Name_From_Path /= No_Name)
1618 and then Expected_Name /= Name_From_Path
1619 then
1620 Error_Msg_Name_1 := Expected_Name;
1621
1622 if Is_Config_File then
1623 Extension := new String'(Config_Project_File_Extension);
1624
1625 else
1626 Extension := new String'(Project_File_Extension);
1627 end if;
1628
1629 Error_Msg
1630 (Env.Flags,
1631 "?file name does not match project name, should be `%%"
1632 & Extension.all & "`",
1633 Token_Ptr);
1634 end if;
1635 end;
1636
1637 -- Read the original casing of the project name and put it in the
1638 -- project node.
1639
1640 declare
1641 Loc : Source_Ptr;
1642 begin
1643 Loc := Location_Of (Project, In_Tree);
1644 for J in 1 .. Name_Len loop
1645 Name_Buffer (J) := Sinput.Source (Loc);
1646 Loc := Loc + 1;
1647 end loop;
1648
1649 Set_Display_Name_Of (Project, In_Tree, Name_Find);
1650 end;
1651
1652 declare
1653 From_Ext : Extension_Origin := None;
1654
1655 begin
1656 -- Extending_All is always propagated
1657
1658 if From_Extended = Extending_All or else Extends_All then
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
1668 Post_Parse_Context_Clause
1669 (In_Tree => In_Tree,
1670 Context_Clause => First_With,
1671 In_Limited => In_Limited,
1672 Limited_Withs => False,
1673 Imported_Projects => Imported_Projects,
1674 Project_Directory => Project_Directory,
1675 From_Extended => From_Ext,
1676 Packages_To_Check => Packages_To_Check,
1677 Depth => Depth + 1,
1678 Current_Dir => Current_Dir,
1679 Is_Config_File => Is_Config_File,
1680 Env => Env);
1681 Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects);
1682 end;
1683
1684 if not Is_Config_File then
1685 declare
1686 Name_And_Node : Tree_Private_Part.Project_Name_And_Node :=
1687 Tree_Private_Part.Projects_Htable.Get_First
1688 (In_Tree.Projects_HT);
1689 Project_Name : Name_Id := Name_And_Node.Name;
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;
1702
1703 -- Report an error if we already have a project with this name
1704
1705 if Project_Name /= No_Name then
1706 Duplicated := True;
1707 Error_Msg_Name_1 := Project_Name;
1708 Error_Msg
1709 (Env.Flags, "duplicate project name %%",
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
1714 (Env.Flags,
1715 "\already in %%", Location_Of (Project, In_Tree));
1716 end if;
1717 end;
1718 end if;
1719
1720 end if;
1721
1722 if Extending then
1723 Expect (Tok_String_Literal, "literal string");
1724
1725 if Token = Tok_String_Literal then
1726 Set_Extended_Project_Path_Of
1727 (Project,
1728 In_Tree,
1729 Path_Name_Type (Token_Name));
1730
1731 declare
1732 Original_Path_Name : constant String :=
1733 Get_Name_String (Token_Name);
1734
1735 Extended_Project_Path_Name_Id : Path_Name_Type;
1736
1737 begin
1738 Find_Project
1739 (Env.Project_Path,
1740 Project_File_Name => Original_Path_Name,
1741 Directory => Get_Name_String (Project_Directory),
1742 Path => Extended_Project_Path_Name_Id);
1743
1744 if Extended_Project_Path_Name_Id = No_Path then
1745
1746 -- We could not find the project file to extend
1747
1748 Error_Msg_Name_1 := Token_Name;
1749
1750 Error_Msg (Env.Flags, "unknown project file: %%", Token_Ptr);
1751
1752 -- If not in the main project file, display the import path
1753
1754 if Project_Stack.Last > 1 then
1755 Error_Msg_Name_1 :=
1756 Name_Id
1757 (Project_Stack.Table (Project_Stack.Last).Path_Name);
1758 Error_Msg (Env.Flags, "\extended by %%", Token_Ptr);
1759
1760 for Index in reverse 1 .. Project_Stack.Last - 1 loop
1761 Error_Msg_Name_1 :=
1762 Name_Id
1763 (Project_Stack.Table (Index).Path_Name);
1764 Error_Msg (Env.Flags, "\imported by %%", Token_Ptr);
1765 end loop;
1766 end if;
1767
1768 else
1769 declare
1770 From_Ext : Extension_Origin := None;
1771
1772 begin
1773 if From_Extended = Extending_All or else Extends_All then
1774 From_Ext := Extending_All;
1775 end if;
1776
1777 Parse_Single_Project
1778 (In_Tree => In_Tree,
1779 Project => Extended_Project,
1780 Extends_All => Extends_All,
1781 Path_Name_Id => Extended_Project_Path_Name_Id,
1782 Extended => True,
1783 From_Extended => From_Ext,
1784 In_Limited => In_Limited,
1785 Packages_To_Check => Packages_To_Check,
1786 Depth => Depth + 1,
1787 Current_Dir => Current_Dir,
1788 Is_Config_File => Is_Config_File,
1789 Env => Env);
1790 end;
1791
1792 if Present (Extended_Project) then
1793
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
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
1813 -- project. Otherwise we may have an abstract project
1814 -- with sources if it inherits sources from the project
1815 -- it extends.
1816
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
1822 then
1823 Error_Msg
1824 (Env.Flags, "an abstract project can only extend " &
1825 "another abstract project",
1826 Qualifier_Location);
1827 end if;
1828 end if;
1829 end if;
1830 end;
1831
1832 Scan (In_Tree); -- past the extended project path
1833 end if;
1834 end if;
1835
1836 Check_Extending_All_Imports (Env.Flags, In_Tree, Project);
1837 Check_Aggregate_Imports (Env.Flags, In_Tree, Project);
1838 Check_Import_Aggregate (Env.Flags, In_Tree, Project);
1839
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
1856 -- If a dot was found, check if parent project is imported or extended
1857
1858 if Name_Len > 0 then
1859 Name_Len := Name_Len - 1;
1860
1861 declare
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);
1867 Imp_Proj_Name : Name_Id;
1868
1869 begin
1870 -- If there is an extended project, check its name
1871
1872 if Present (Extended_Project) then
1873 Parent_Node := Extended_Project;
1874 Parent_Found :=
1875 Name_Of (Extended_Project, In_Tree) = Parent_Name;
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
1881 Imported_Loop :
1882 while not Parent_Found and then Present (With_Clause) loop
1883 Parent_Node := Project_Node_Of (With_Clause, In_Tree);
1884 Extension_Loop : while Present (Parent_Node) loop
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
1894 With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
1895 end loop Imported_Loop;
1896
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
1902
1903 Error_Msg_Name_1 := Name_Of_Project;
1904 Error_Msg_Name_2 := Parent_Name;
1905 Error_Msg (Env.Flags,
1906 "project %% does not import or extend project %%",
1907 Location_Of (Project, In_Tree));
1908 end if;
1909 end;
1910 end if;
1911
1912 Expect (Tok_Is, "IS");
1913 Set_End_Of_Line (Project);
1914 Set_Previous_Line_Node (Project);
1915 Set_Next_End_Node (Project);
1916
1917 declare
1918 Project_Declaration : Project_Node_Id := Empty_Node;
1919
1920 begin
1921 -- No need to Scan past "is", Prj.Dect.Parse will do it
1922
1923 Prj.Dect.Parse
1924 (In_Tree => In_Tree,
1925 Declarations => Project_Declaration,
1926 Current_Project => Project,
1927 Extends => Extended_Project,
1928 Packages_To_Check => Packages_To_Check,
1929 Is_Config_File => Is_Config_File,
1930 Flags => Env.Flags);
1931 Set_Project_Declaration_Of (Project, In_Tree, Project_Declaration);
1932
1933 if Present (Extended_Project)
1934 and then Project_Qualifier_Of (Extended_Project, In_Tree) /=
1935 Abstract_Project
1936 then
1937 Set_Extending_Project_Of
1938 (Project_Declaration_Of (Extended_Project, In_Tree), In_Tree,
1939 To => Project);
1940 end if;
1941 end;
1942
1943 Expect (Tok_End, "END");
1944 Remove_Next_End_Node;
1945
1946 -- Skip "end" if present
1947
1948 if Token = Tok_End then
1949 Scan (In_Tree);
1950 end if;
1951
1952 -- Clear the Buffer
1953
1954 Buffer_Last := 0;
1955
1956 -- Store the name following "end" in the Buffer. The name may be made of
1957 -- several simple names.
1958
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);
1972 Add_To_Buffer (Name_Buffer (1 .. Name_Len), Buffer, Buffer_Last);
1973
1974 -- Scan past the identifier
1975
1976 Scan (In_Tree);
1977 exit when Token /= Tok_Dot;
1978 Add_To_Buffer (".", Buffer, Buffer_Last);
1979 Scan (In_Tree);
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)) /=
1986 Get_Name_String (Name_Of (Project, In_Tree))
1987 then
1988 -- Invalid name: report an error
1989
1990 Error_Msg (Env.Flags, "expected """ &
1991 Get_Name_String (Name_Of (Project, In_Tree)) & """",
1992 Token_Ptr);
1993 end if;
1994 end if;
1995
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
2002 Set_Previous_End_Node (Project);
2003 Scan (In_Tree);
2004
2005 if Token /= Tok_EOF then
2006 Error_Msg
2007 (Env.Flags,
2008 "unexpected text following end of project", Token_Ptr);
2009 end if;
2010 end if;
2011
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,
2022 Resolved_Path => Resolved_Path_Name,
2023 Extended => Extended,
2024 From_Extended => From_Extended /= None,
2025 Proj_Qualifier => Project_Qualifier_Of (Project, In_Tree)));
2026 end if;
2027
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,
2047 In_Limited => In_Limited,
2048 Limited_Withs => True,
2049 Imported_Projects => Imported_Projects,
2050 Project_Directory => Project_Directory,
2051 From_Extended => From_Ext,
2052 Packages_To_Check => Packages_To_Check,
2053 Depth => Depth + 1,
2054 Current_Dir => Current_Dir,
2055 Is_Config_File => Is_Config_File,
2056 Env => Env);
2057 Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects);
2058 end;
2059
2060 -- Restore the scan state, in case we are not the main project
2061
2062 Restore_Project_Scan_State (Project_Scan_State);
2063
2064 -- And remove the project from the project stack
2065
2066 Project_Stack.Decrement_Last;
2067
2068 -- Indicate if there are unkept comments
2069
2070 Tree.Set_Project_File_Includes_Unkept_Comments
2071 (Node => Project,
2072 In_Tree => In_Tree,
2073 To => Tree.There_Are_Unkept_Comments);
2074
2075 -- And restore the comment state that was saved
2076
2077 Tree.Restore_And_Free (Project_Comment_State);
2078
2079 Debug_Decrease_Indent;
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;
2087 end Parse_Single_Project;
2088
2089 -----------------------
2090 -- Project_Name_From --
2091 -----------------------
2092
2093 function Project_Name_From
2094 (Path_Name : String;
2095 Is_Config_File : Boolean) return Name_Id
2096 is
2097 Canonical : String (1 .. Path_Name'Length) := Path_Name;
2098 First : Natural := Canonical'Last;
2099 Last : Natural := First;
2100 Index : Positive;
2101
2102 begin
2103 if Current_Verbosity = High then
2104 Debug_Output ("Project_Name_From (""" & Canonical & """)");
2105 end if;
2106
2107 -- If the path name is empty, return No_Name to indicate failure
2108
2109 if First = 0 then
2110 return No_Name;
2111 end if;
2112
2113 Canonical_Case_File_Name (Canonical);
2114
2115 -- Look for the last dot in the path name
2116
2117 while First > 0
2118 and then
2119 Canonical (First) /= '.'
2120 loop
2121 First := First - 1;
2122 end loop;
2123
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
2127 if (not Is_Config_File
2128 and then Canonical (First .. Last) = Project_File_Extension
2129 and then First /= 1)
2130 or else
2131 (Is_Config_File
2132 and then
2133 Canonical (First .. Last) = Config_Project_File_Extension
2134 and then First /= 1)
2135 then
2136 -- Look for the last directory separator, if any
2137
2138 First := First - 1;
2139 Last := First;
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
2148 -- Not the correct extension, return No_Name to indicate failure
2149
2150 return No_Name;
2151 end if;
2152
2153 -- If no dot in the path name, return No_Name to indicate failure
2154
2155 else
2156 return No_Name;
2157 end if;
2158
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
2164 return No_Name;
2165 end if;
2166
2167 -- Put the name in lower case into Name_Buffer
2168
2169 Name_Len := Last - First + 1;
2170 Name_Buffer (1 .. Name_Len) := To_Lower (Canonical (First .. Last));
2171
2172 Index := 1;
2173
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
2179 return No_Name;
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
2189 return No_Name;
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
2198 return No_Name;
2199 end if;
2200
2201 end loop;
2202 end if;
2203
2204 if Index >= Name_Len then
2205 if Is_Alphanumeric (Name_Buffer (Name_Len)) then
2206
2207 -- All checks have succeeded. Return name in Name_Buffer
2208
2209 return Name_Find;
2210
2211 else
2212 return No_Name;
2213 end if;
2214
2215 elsif Name_Buffer (Index) = '-' then
2216 Index := Index + 1;
2217 end if;
2218 end loop;
2219 end Project_Name_From;
2220
2221 end Prj.Part;
Mirror of the offical gcc git repository hosted at gcc.gnu.org