?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
* tree-loop-distribution.c (struct partition): New field recording
[official-gcc.git] / gcc / ada / prj-part.adb
blob7afe8c0a3d0771dc95382cb9f1124003de09756d
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-2017, 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 Path_Name_Id : Path_Name_Type;
550
551 begin
552 In_Tree.Incomplete_With := False;
553 Project_Stack.Init;
554 Tree_Private_Part.Projects_Htable.Reset (In_Tree.Projects_HT);
555
556 if not Is_Initialized (Env.Project_Path) then
557 Prj.Env.Initialize_Default_Project_Path
558 (Env.Project_Path, Target_Name);
559 end if;
560
561 Project := Empty_Node;
562
563 Find_Project (Env.Project_Path,
564 Project_File_Name => Project_File_Name,
565 Directory => Current_Directory,
566 Path => Path_Name_Id);
567
568 if Errout_Handling /= Never_Finalize then
569 Prj.Err.Initialize;
570 end if;
571
572 Prj.Err.Scanner.Set_Comment_As_Token (Store_Comments);
573 Prj.Err.Scanner.Set_End_Of_Line_As_Token (Store_Comments);
574
575 if Path_Name_Id = No_Path then
576 declare
577 P : String_Access;
578 begin
579 Get_Path (Env.Project_Path, Path => P);
580
581 Prj.Com.Fail
582 ("project file """
583 & Project_File_Name
584 & """ not found in "
585 & P.all);
586 Project := Empty_Node;
587 return;
588 end;
589 end if;
590
591 -- Parse the main project file
592
593 begin
594 Parse_Single_Project
595 (In_Tree => In_Tree,
596 Project => Project,
597 Extends_All => Dummy,
598 Path_Name_Id => Path_Name_Id,
599 Extended => False,
600 From_Extended => None,
601 In_Limited => False,
602 Packages_To_Check => Packages_To_Check,
603 Depth => 0,
604 Current_Dir => Current_Directory,
605 Is_Config_File => Is_Config_File,
606 Env => Env,
607 Implicit_Project => Implicit_Project);
608
609 exception
610 when Types.Unrecoverable_Error =>
611
612 -- Unrecoverable_Error is raised when a line is too long.
613 -- A meaningful error message will be displayed later.
614
615 Project := Empty_Node;
616 end;
617
618 -- If Project is an extending-all project, create the eventual
619 -- virtual extending projects and check that there are no illegally
620 -- imported projects.
621
622 if Present (Project)
623 and then Is_Extending_All (Project, In_Tree)
624 then
625 -- First look for projects that potentially need a virtual
626 -- extending project.
627
628 Virtual_Hash.Reset;
629 Processed_Hash.Reset;
630
631 -- Mark the extending all project as processed, to avoid checking
632 -- the imported projects in case of a "limited with" on this
633 -- extending all project.
634
635 Processed_Hash.Set (Project, True);
636
637 declare
638 Declaration : constant Project_Node_Id :=
639 Project_Declaration_Of (Project, In_Tree);
640 begin
641 Extension_Withs := First_With_Clause_Of (Project, In_Tree);
642 Look_For_Virtual_Projects_For
643 (Extended_Project_Of (Declaration, In_Tree), In_Tree,
644 Potentially_Virtual => False);
645 end;
646
647 -- Now, check the projects directly imported by the main project.
648 -- Remove from the potentially virtual any project extended by one
649 -- of these imported projects.
650
651 declare
652 With_Clause : Project_Node_Id;
653 Imported : Project_Node_Id := Empty_Node;
654 Declaration : Project_Node_Id := Empty_Node;
655
656 begin
657 With_Clause := First_With_Clause_Of (Project, In_Tree);
658 while Present (With_Clause) loop
659 Imported := Project_Node_Of (With_Clause, In_Tree);
660
661 if Present (Imported) then
662 Declaration := Project_Declaration_Of (Imported, In_Tree);
663
664 if Extended_Project_Of (Declaration, In_Tree) /=
665 Empty_Node
666 then
667 loop
668 Imported :=
669 Extended_Project_Of (Declaration, In_Tree);
670 exit when No (Imported);
671 Virtual_Hash.Remove (Imported);
672 Declaration :=
673 Project_Declaration_Of (Imported, In_Tree);
674 end loop;
675 end if;
676 end if;
677
678 With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
679 end loop;
680 end;
681
682 -- Now create all the virtual extending projects
683
684 declare
685 Proj : Project_Node_Id := Empty_Node;
686 Withs : Project_Node_Id;
687 begin
688 Virtual_Hash.Get_First (Proj, Withs);
689 while Withs /= Project_Node_High_Bound loop
690 Create_Virtual_Extending_Project
691 (Proj, Project, Withs, In_Tree);
692 Virtual_Hash.Get_Next (Proj, Withs);
693 end loop;
694 end;
695 end if;
696
697 -- If there were any kind of error during the parsing, serious
698 -- or not, then the parsing fails.
699
700 if Total_Errors_Detected > 0 then
701 Project := Empty_Node;
702 end if;
703
704 case Errout_Handling is
705 when Always_Finalize =>
706 Prj.Err.Finalize;
707
708 -- Reinitialize to avoid duplicate warnings later on
709 Prj.Err.Initialize;
710
711 when Finalize_If_Error =>
712 if No (Project) then
713 Prj.Err.Finalize;
714 Prj.Err.Initialize;
715 end if;
716
717 when Never_Finalize =>
718 null;
719 end case;
720
721 exception
722 when X : others =>
723
724 -- Internal error
725
726 Write_Line (Exception_Information (X));
727 Write_Str ("Exception ");
728 Write_Str (Exception_Name (X));
729 Write_Line (" raised, while processing project file");
730 Project := Empty_Node;
731 end Parse;
732
733 ------------------------------
734 -- Pre_Parse_Context_Clause --
735 ------------------------------
736
737 procedure Pre_Parse_Context_Clause
738 (In_Tree : Project_Node_Tree_Ref;
739 Context_Clause : out With_Id;
740 Is_Config_File : Boolean;
741 Flags : Processing_Flags)
742 is
743 Current_With_Clause : With_Id := No_With;
744 Limited_With : Boolean := False;
745 Current_With : With_Record;
746 Current_With_Node : Project_Node_Id := Empty_Node;
747
748 begin
749 -- Assume no context clause
750
751 Context_Clause := No_With;
752 With_Loop :
753
754 -- If Token is not WITH or LIMITED, there is no context clause, or we
755 -- have exhausted the with clauses.
756
757 while Token = Tok_With or else Token = Tok_Limited loop
758 Current_With_Node :=
759 Default_Project_Node (Of_Kind => N_With_Clause, In_Tree => In_Tree);
760 Limited_With := Token = Tok_Limited;
761
762 if Is_Config_File then
763 Error_Msg
764 (Flags,
765 "configuration project cannot import " &
766 "other configuration projects",
767 Token_Ptr);
768 end if;
769
770 if Limited_With then
771 Scan (In_Tree); -- past LIMITED
772 Expect (Tok_With, "WITH");
773 exit With_Loop when Token /= Tok_With;
774 end if;
775
776 Comma_Loop :
777 loop
778 Scan (In_Tree); -- past WITH or ","
779
780 Expect (Tok_String_Literal, "literal string");
781
782 if Token /= Tok_String_Literal then
783 return;
784 end if;
785
786 -- Store path and location in table Withs
787
788 Current_With :=
789 (Path => Path_Name_Type (Token_Name),
790 Location => Token_Ptr,
791 Limited_With => Limited_With,
792 Node => Current_With_Node,
793 Next => No_With);
794
795 Withs.Increment_Last;
796 Withs.Table (Withs.Last) := Current_With;
797
798 if Current_With_Clause = No_With then
799 Context_Clause := Withs.Last;
800
801 else
802 Withs.Table (Current_With_Clause).Next := Withs.Last;
803 end if;
804
805 Current_With_Clause := Withs.Last;
806
807 Scan (In_Tree);
808
809 if Token = Tok_Semicolon then
810 Set_End_Of_Line (Current_With_Node);
811 Set_Previous_Line_Node (Current_With_Node);
812
813 -- End of (possibly multiple) with clause;
814
815 Scan (In_Tree); -- past semicolon
816 exit Comma_Loop;
817
818 elsif Token = Tok_Comma then
819 Set_Is_Not_Last_In_List (Current_With_Node, In_Tree);
820
821 else
822 Error_Msg (Flags, "expected comma or semi colon", Token_Ptr);
823 exit Comma_Loop;
824 end if;
825
826 Current_With_Node :=
827 Default_Project_Node
828 (Of_Kind => N_With_Clause, In_Tree => In_Tree);
829 end loop Comma_Loop;
830 end loop With_Loop;
831 end Pre_Parse_Context_Clause;
832
833 -------------------------------
834 -- Post_Parse_Context_Clause --
835 -------------------------------
836
837 procedure Post_Parse_Context_Clause
838 (Context_Clause : With_Id;
839 In_Tree : Project_Node_Tree_Ref;
840 In_Limited : Boolean;
841 Limited_Withs : Boolean;
842 Imported_Projects : in out Project_Node_Id;
843 Project_Directory : Path_Name_Type;
844 From_Extended : Extension_Origin;
845 Packages_To_Check : String_List_Access;
846 Depth : Natural;
847 Current_Dir : String;
848 Is_Config_File : Boolean;
849 Env : in out Environment)
850 is
851 Current_With_Clause : With_Id := Context_Clause;
852
853 Current_Project : Project_Node_Id := Imported_Projects;
854 Previous_Project : Project_Node_Id := Empty_Node;
855 Next_Project : Project_Node_Id := Empty_Node;
856
857 Project_Directory_Path : constant String :=
858 Get_Name_String (Project_Directory);
859
860 Current_With : With_Record;
861 Extends_All : Boolean := False;
862 Imported_Path_Name_Id : Path_Name_Type;
863
864 begin
865 -- Set Current_Project to the last project in the current list, if the
866 -- list is not empty.
867
868 if Present (Current_Project) then
869 while
870 Present (Next_With_Clause_Of (Current_Project, In_Tree))
871 loop
872 Current_Project := Next_With_Clause_Of (Current_Project, In_Tree);
873 end loop;
874 end if;
875
876 while Current_With_Clause /= No_With loop
877 Current_With := Withs.Table (Current_With_Clause);
878 Current_With_Clause := Current_With.Next;
879
880 if Limited_Withs = Current_With.Limited_With then
881 Find_Project
882 (Env.Project_Path,
883 Project_File_Name => Get_Name_String (Current_With.Path),
884 Directory => Project_Directory_Path,
885 Path => Imported_Path_Name_Id);
886
887 if Imported_Path_Name_Id = No_Path then
888 if Env.Flags.Ignore_Missing_With then
889 In_Tree.Incomplete_With := True;
890 Env.Flags.Incomplete_Withs := True;
891
892 else
893 -- The project file cannot be found
894
895 Error_Msg_File_1 := File_Name_Type (Current_With.Path);
896 Error_Msg
897 (Env.Flags, "unknown project file: {",
898 Current_With.Location);
899
900 -- If this is not imported by the main project file, display
901 -- the import path.
902
903 if Project_Stack.Last > 1 then
904 for Index in reverse 1 .. Project_Stack.Last loop
905 Error_Msg_File_1 :=
906 File_Name_Type
907 (Project_Stack.Table (Index).Path_Name);
908 Error_Msg
909 (Env.Flags, "\imported by {", Current_With.Location);
910 end loop;
911 end if;
912 end if;
913
914 else
915 -- New with clause
916
917 declare
918 Resolved_Path : constant String :=
919 Normalize_Pathname
920 (Get_Name_String (Imported_Path_Name_Id),
921 Directory => Current_Dir,
922 Resolve_Links =>
923 Opt.Follow_Links_For_Files,
924 Case_Sensitive => True);
925
926 Withed_Project : Project_Node_Id := Empty_Node;
927
928 begin
929 Previous_Project := Current_Project;
930
931 if No (Current_Project) then
932
933 -- First with clause of the context clause
934
935 Current_Project := Current_With.Node;
936 Imported_Projects := Current_Project;
937
938 else
939 Next_Project := Current_With.Node;
940 Set_Next_With_Clause_Of
941 (Current_Project, In_Tree, Next_Project);
942 Current_Project := Next_Project;
943 end if;
944
945 Set_String_Value_Of
946 (Current_Project,
947 In_Tree,
948 Name_Id (Current_With.Path));
949 Set_Location_Of
950 (Current_Project, In_Tree, Current_With.Location);
951
952 -- If it is a limited with, check if we have a circularity.
953 -- If we have one, get the project id of the limited
954 -- imported project file, and do not parse it.
955
956 if (In_Limited or Limited_Withs)
957 and then Project_Stack.Last > 1
958 then
959 declare
960 Canonical_Path_Name : Path_Name_Type;
961
962 begin
963 Name_Len := Resolved_Path'Length;
964 Name_Buffer (1 .. Name_Len) := Resolved_Path;
965 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
966 Canonical_Path_Name := Name_Find;
967
968 for Index in 1 .. Project_Stack.Last loop
969 if Project_Stack.Table (Index).Canonical_Path_Name =
970 Canonical_Path_Name
971 then
972 -- We have found the limited imported project,
973 -- get its project id, and do not parse it.
974
975 Withed_Project := Project_Stack.Table (Index).Id;
976 exit;
977 end if;
978 end loop;
979 end;
980 end if;
981
982 -- Parse the imported project if its project id is unknown
983
984 if No (Withed_Project) then
985 Parse_Single_Project
986 (In_Tree => In_Tree,
987 Project => Withed_Project,
988 Extends_All => Extends_All,
989 Path_Name_Id => Imported_Path_Name_Id,
990 Extended => False,
991 From_Extended => From_Extended,
992 In_Limited => In_Limited or Limited_Withs,
993 Packages_To_Check => Packages_To_Check,
994 Depth => Depth,
995 Current_Dir => Current_Dir,
996 Is_Config_File => Is_Config_File,
997 Env => Env);
998
999 else
1000 Extends_All := Is_Extending_All (Withed_Project, In_Tree);
1001 end if;
1002
1003 if No (Withed_Project) then
1004
1005 -- If parsing unsuccessful, remove the context clause
1006
1007 Current_Project := Previous_Project;
1008
1009 if No (Current_Project) then
1010 Imported_Projects := Empty_Node;
1011
1012 else
1013 Set_Next_With_Clause_Of
1014 (Current_Project, In_Tree, Empty_Node);
1015 end if;
1016 else
1017 -- If parsing was successful, record project name and
1018 -- path name in with clause
1019
1020 Set_Project_Node_Of
1021 (Node => Current_Project,
1022 In_Tree => In_Tree,
1023 To => Withed_Project,
1024 Limited_With => Current_With.Limited_With);
1025 Set_Name_Of
1026 (Current_Project,
1027 In_Tree,
1028 Name_Of (Withed_Project, In_Tree));
1029
1030 Name_Len := Resolved_Path'Length;
1031 Name_Buffer (1 .. Name_Len) := Resolved_Path;
1032 Set_Path_Name_Of (Current_Project, In_Tree, Name_Find);
1033
1034 if Extends_All then
1035 Set_Is_Extending_All (Current_Project, In_Tree);
1036 end if;
1037 end if;
1038 end;
1039 end if;
1040 end if;
1041 end loop;
1042 end Post_Parse_Context_Clause;
1043
1044 ---------------------------------
1045 -- Check_Extending_All_Imports --
1046 ---------------------------------
1047
1048 procedure Check_Extending_All_Imports
1049 (Flags : Processing_Flags;
1050 In_Tree : Project_Node_Tree_Ref;
1051 Project : Project_Node_Id)
1052 is
1053 With_Clause : Project_Node_Id;
1054 Imported : Project_Node_Id;
1055
1056 begin
1057 if not Is_Extending_All (Project, In_Tree) then
1058 With_Clause := First_With_Clause_Of (Project, In_Tree);
1059 while Present (With_Clause) loop
1060 Imported := Project_Node_Of (With_Clause, In_Tree);
1061
1062 if Is_Extending_All (With_Clause, In_Tree) then
1063 Error_Msg_Name_1 := Name_Of (Imported, In_Tree);
1064 Error_Msg (Flags, "cannot import extending-all project %%",
1065 Token_Ptr);
1066 exit;
1067 end if;
1068
1069 With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
1070 end loop;
1071 end if;
1072 end Check_Extending_All_Imports;
1073
1074 -----------------------------
1075 -- Check_Aggregate_Imports --
1076 -----------------------------
1077
1078 procedure Check_Aggregate_Imports
1079 (Flags : Processing_Flags;
1080 In_Tree : Project_Node_Tree_Ref;
1081 Project : Project_Node_Id)
1082 is
1083 With_Clause, Imported : Project_Node_Id;
1084 begin
1085 if Project_Qualifier_Of (Project, In_Tree) = Aggregate then
1086 With_Clause := First_With_Clause_Of (Project, In_Tree);
1087
1088 while Present (With_Clause) loop
1089 Imported := Project_Node_Of (With_Clause, In_Tree);
1090
1091 if Project_Qualifier_Of (Imported, In_Tree) /= Abstract_Project
1092 then
1093 Error_Msg_Name_1 := Name_Id (Path_Name_Of (Imported, In_Tree));
1094 Error_Msg (Flags, "can only import abstract projects, not %%",
1095 Token_Ptr);
1096 exit;
1097 end if;
1098
1099 With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
1100 end loop;
1101 end if;
1102 end Check_Aggregate_Imports;
1103
1104 ----------------------------
1105 -- Check_Import_Aggregate --
1106 ----------------------------
1107
1108 procedure Check_Import_Aggregate
1109 (Flags : Processing_Flags;
1110 In_Tree : Project_Node_Tree_Ref;
1111 Project : Project_Node_Id)
1112 is
1113 With_Clause : Project_Node_Id;
1114 Imported : Project_Node_Id;
1115
1116 begin
1117 if Project_Qualifier_Of (Project, In_Tree) /= Aggregate then
1118 With_Clause := First_With_Clause_Of (Project, In_Tree);
1119 while Present (With_Clause) loop
1120 Imported := Project_Node_Of (With_Clause, In_Tree);
1121
1122 if Project_Qualifier_Of (Imported, In_Tree) = Aggregate then
1123 Error_Msg_Name_1 := Name_Id (Path_Name_Of (Imported, In_Tree));
1124 Error_Msg
1125 (Flags, "cannot import aggregate project %%", Token_Ptr);
1126 exit;
1127 end if;
1128
1129 With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
1130 end loop;
1131 end if;
1132 end Check_Import_Aggregate;
1133
1134 ----------------------------
1135 -- Read_Project_Qualifier --
1136 ----------------------------
1137
1138 procedure Read_Project_Qualifier
1139 (Flags : Processing_Flags;
1140 In_Tree : Project_Node_Tree_Ref;
1141 Is_Config_File : Boolean;
1142 Qualifier_Location : out Source_Ptr;
1143 Project : Project_Node_Id)
1144 is
1145 Proj_Qualifier : Project_Qualifier := Unspecified;
1146 begin
1147 Qualifier_Location := Token_Ptr;
1148
1149 if Token = Tok_Abstract then
1150 Proj_Qualifier := Abstract_Project;
1151 Scan (In_Tree);
1152
1153 elsif Token = Tok_Identifier then
1154 case Token_Name is
1155 when Snames.Name_Standard =>
1156 Proj_Qualifier := Standard;
1157 Scan (In_Tree);
1158
1159 when Snames.Name_Aggregate =>
1160 Proj_Qualifier := Aggregate;
1161 Scan (In_Tree);
1162
1163 if Token = Tok_Identifier
1164 and then Token_Name = Snames.Name_Library
1165 then
1166 Proj_Qualifier := Aggregate_Library;
1167 Scan (In_Tree);
1168 end if;
1169
1170 when Snames.Name_Library =>
1171 Proj_Qualifier := Library;
1172 Scan (In_Tree);
1173
1174 when Snames.Name_Configuration =>
1175 if not Is_Config_File then
1176 Error_Msg
1177 (Flags,
1178 "configuration projects cannot belong to a user" &
1179 " project tree",
1180 Token_Ptr);
1181 end if;
1182
1183 Proj_Qualifier := Configuration;
1184 Scan (In_Tree);
1185
1186 when others =>
1187 null;
1188 end case;
1189 end if;
1190
1191 if Is_Config_File and then Proj_Qualifier = Unspecified then
1192
1193 -- Set the qualifier to Configuration, even if the token doesn't
1194 -- exist in the source file itself, so that we can differentiate
1195 -- project files and configuration files later on.
1196
1197 Proj_Qualifier := Configuration;
1198 end if;
1199
1200 if Proj_Qualifier /= Unspecified then
1201 if Is_Config_File
1202 and then Proj_Qualifier /= Configuration
1203 then
1204 Error_Msg (Flags,
1205 "a configuration project cannot be qualified except " &
1206 "as configuration project",
1207 Qualifier_Location);
1208 end if;
1209
1210 Set_Project_Qualifier_Of (Project, In_Tree, Proj_Qualifier);
1211 end if;
1212 end Read_Project_Qualifier;
1213
1214 -------------------------------
1215 -- Has_Circular_Dependencies --
1216 -------------------------------
1217
1218 function Has_Circular_Dependencies
1219 (Flags : Processing_Flags;
1220 Normed_Path_Name : Path_Name_Type;
1221 Canonical_Path_Name : Path_Name_Type) return Boolean is
1222 begin
1223 for Index in reverse 1 .. Project_Stack.Last loop
1224 exit when Project_Stack.Table (Index).Limited_With;
1225
1226 if Canonical_Path_Name =
1227 Project_Stack.Table (Index).Canonical_Path_Name
1228 then
1229 Error_Msg (Flags, "circular dependency detected", Token_Ptr);
1230 Error_Msg_Name_1 := Name_Id (Normed_Path_Name);
1231 Error_Msg (Flags, "\ %% is imported by", Token_Ptr);
1232
1233 for Current in reverse 1 .. Project_Stack.Last loop
1234 Error_Msg_Name_1 :=
1235 Name_Id (Project_Stack.Table (Current).Path_Name);
1236
1237 if Project_Stack.Table (Current).Canonical_Path_Name /=
1238 Canonical_Path_Name
1239 then
1240 Error_Msg
1241 (Flags, "\ %% which itself is imported by", Token_Ptr);
1242
1243 else
1244 Error_Msg (Flags, "\ %%", Token_Ptr);
1245 exit;
1246 end if;
1247 end loop;
1248
1249 return True;
1250 end if;
1251 end loop;
1252 return False;
1253 end Has_Circular_Dependencies;
1254
1255 --------------------------
1256 -- Parse_Single_Project --
1257 --------------------------
1258
1259 procedure Parse_Single_Project
1260 (In_Tree : Project_Node_Tree_Ref;
1261 Project : out Project_Node_Id;
1262 Extends_All : out Boolean;
1263 Path_Name_Id : Path_Name_Type;
1264 Extended : Boolean;
1265 From_Extended : Extension_Origin;
1266 In_Limited : Boolean;
1267 Packages_To_Check : String_List_Access;
1268 Depth : Natural;
1269 Current_Dir : String;
1270 Is_Config_File : Boolean;
1271 Env : in out Environment;
1272 Implicit_Project : Boolean := False)
1273 is
1274 Path_Name : constant String := Get_Name_String (Path_Name_Id);
1275
1276 Normed_Path_Name : Path_Name_Type;
1277 Canonical_Path_Name : Path_Name_Type;
1278 Resolved_Path_Name : Path_Name_Type;
1279 Project_Directory : Path_Name_Type;
1280 Project_Scan_State : Saved_Project_Scan_State;
1281 Source_Index : Source_File_Index;
1282
1283 Extending : Boolean := False;
1284
1285 Extended_Project : Project_Node_Id := Empty_Node;
1286
1287 A_Project_Name_And_Node : Tree_Private_Part.Project_Name_And_Node :=
1288 Tree_Private_Part.Projects_Htable.Get_First
1289 (In_Tree.Projects_HT);
1290
1291 Name_From_Path : constant Name_Id :=
1292 Project_Name_From (Path_Name, Is_Config_File => Is_Config_File);
1293 Name_Of_Project : Name_Id := No_Name;
1294
1295 Duplicated : Boolean := False;
1296
1297 First_With : With_Id;
1298 Imported_Projects : Project_Node_Id := Empty_Node;
1299
1300 use Tree_Private_Part;
1301
1302 Project_Comment_State : Tree.Comment_State;
1303
1304 Qualifier_Location : Source_Ptr;
1305
1306 begin
1307 Extends_All := False;
1308
1309 declare
1310 Normed_Path : constant String := Normalize_Pathname
1311 (Path_Name,
1312 Directory => Current_Dir,
1313 Resolve_Links => False,
1314 Case_Sensitive => True);
1315 Canonical_Path : constant String := Normalize_Pathname
1316 (Normed_Path,
1317 Directory => Current_Dir,
1318 Resolve_Links => Opt.Follow_Links_For_Files,
1319 Case_Sensitive => False);
1320 begin
1321 Name_Len := Normed_Path'Length;
1322 Name_Buffer (1 .. Name_Len) := Normed_Path;
1323 Normed_Path_Name := Name_Find;
1324 Name_Len := Canonical_Path'Length;
1325 Name_Buffer (1 .. Name_Len) := Canonical_Path;
1326 Canonical_Path_Name := Name_Find;
1327
1328 if Opt.Follow_Links_For_Files then
1329 Resolved_Path_Name := Canonical_Path_Name;
1330
1331 else
1332 Name_Len := 0;
1333 Add_Str_To_Name_Buffer
1334 (Normalize_Pathname
1335 (Canonical_Path,
1336 Resolve_Links => True,
1337 Case_Sensitive => False));
1338 Resolved_Path_Name := Name_Find;
1339 end if;
1340
1341 end;
1342
1343 if Has_Circular_Dependencies
1344 (Env.Flags, Normed_Path_Name, Canonical_Path_Name)
1345 then
1346 Project := Empty_Node;
1347 return;
1348 end if;
1349
1350 -- Put the new path name on the stack
1351
1352 Project_Stack.Append
1353 ((Path_Name => Normed_Path_Name,
1354 Canonical_Path_Name => Canonical_Path_Name,
1355 Id => Empty_Node,
1356 Limited_With => In_Limited));
1357
1358 -- Check if the project file has already been parsed
1359
1360 while
1361 A_Project_Name_And_Node /= Tree_Private_Part.No_Project_Name_And_Node
1362 loop
1363 if A_Project_Name_And_Node.Resolved_Path = Resolved_Path_Name then
1364 if Extended then
1365
1366 if A_Project_Name_And_Node.Extended then
1367 if A_Project_Name_And_Node.Proj_Qualifier /= Abstract_Project
1368 then
1369 Error_Msg
1370 (Env.Flags,
1371 "cannot extend the same project file several times",
1372 Token_Ptr);
1373 end if;
1374 elsif not A_Project_Name_And_Node.From_Extended then
1375 Error_Msg
1376 (Env.Flags,
1377 "cannot extend an already imported project file",
1378 Token_Ptr);
1379
1380 else
1381 -- Register this project as being extended
1382
1383 A_Project_Name_And_Node.Extended := True;
1384 Tree_Private_Part.Projects_Htable.Set
1385 (In_Tree.Projects_HT,
1386 A_Project_Name_And_Node.Name,
1387 A_Project_Name_And_Node);
1388 end if;
1389
1390 elsif A_Project_Name_And_Node.Extended then
1391 Extends_All :=
1392 Is_Extending_All (A_Project_Name_And_Node.Node, In_Tree);
1393
1394 -- If the imported project is an extended project A, and we are
1395 -- in an extended project, replace A with the ultimate project
1396 -- extending A.
1397
1398 if From_Extended /= None then
1399 declare
1400 Decl : Project_Node_Id :=
1401 Project_Declaration_Of
1402 (A_Project_Name_And_Node.Node, In_Tree);
1403
1404 Prj : Project_Node_Id :=
1405 A_Project_Name_And_Node.Node;
1406
1407 begin
1408 -- Loop through extending projects to find the ultimate
1409 -- extending project, that is the one that is not
1410 -- extended. For an abstract project, as it can be
1411 -- extended several times, there is no extending project
1412 -- registered, so the loop does not execute and the
1413 -- resulting project is the abstract project.
1414
1415 while
1416 Extending_Project_Of (Decl, In_Tree) /= Empty_Node
1417 loop
1418 Prj := Extending_Project_Of (Decl, In_Tree);
1419 Decl := Project_Declaration_Of (Prj, In_Tree);
1420 end loop;
1421
1422 A_Project_Name_And_Node.Node := Prj;
1423 end;
1424 else
1425 Error_Msg
1426 (Env.Flags,
1427 "cannot import an already extended project file",
1428 Token_Ptr);
1429 end if;
1430
1431 elsif A_Project_Name_And_Node.From_Extended then
1432 -- This project is now imported from a non extending project.
1433 -- Indicate this in has table Projects.HT.
1434
1435 A_Project_Name_And_Node.From_Extended := False;
1436 Tree_Private_Part.Projects_Htable.Set
1437 (In_Tree.Projects_HT,
1438 A_Project_Name_And_Node.Name,
1439 A_Project_Name_And_Node);
1440 end if;
1441
1442 Project := A_Project_Name_And_Node.Node;
1443 Project_Stack.Decrement_Last;
1444 return;
1445 end if;
1446
1447 A_Project_Name_And_Node :=
1448 Tree_Private_Part.Projects_Htable.Get_Next (In_Tree.Projects_HT);
1449 end loop;
1450
1451 -- We never encountered this project file. Save the scan state, load the
1452 -- project file and start to scan it.
1453
1454 Save_Project_Scan_State (Project_Scan_State);
1455 Source_Index := Load_Project_File (Path_Name);
1456 Tree.Save (Project_Comment_State);
1457
1458 -- If we cannot find it, we stop
1459
1460 if Source_Index = No_Source_File then
1461 Project := Empty_Node;
1462 Project_Stack.Decrement_Last;
1463 return;
1464 end if;
1465
1466 Prj.Err.Scanner.Initialize_Scanner (Source_Index);
1467 Tree.Reset_State;
1468 Scan (In_Tree);
1469
1470 if not Is_Config_File
1471 and then Name_From_Path = No_Name
1472 and then not Implicit_Project
1473 then
1474
1475 -- The project file name is not correct (no or bad extension, or not
1476 -- following Ada identifier's syntax).
1477
1478 Error_Msg_File_1 := File_Name_Type (Canonical_Path_Name);
1479 Error_Msg (Env.Flags,
1480 "?{ is not a valid path name for a project file",
1481 Token_Ptr);
1482 end if;
1483
1484 if Current_Verbosity >= Medium then
1485 Debug_Increase_Indent ("Parsing """ & Path_Name & '"');
1486 end if;
1487
1488 Project_Directory :=
1489 Path_Name_Type (Get_Directory (File_Name_Type (Normed_Path_Name)));
1490
1491 -- Is there any imported project?
1492
1493 Pre_Parse_Context_Clause
1494 (In_Tree => In_Tree,
1495 Is_Config_File => Is_Config_File,
1496 Context_Clause => First_With,
1497 Flags => Env.Flags);
1498
1499 Project := Default_Project_Node
1500 (Of_Kind => N_Project, In_Tree => In_Tree);
1501 Project_Stack.Table (Project_Stack.Last).Id := Project;
1502 Set_Directory_Of (Project, In_Tree, Project_Directory);
1503 Set_Path_Name_Of (Project, In_Tree, Normed_Path_Name);
1504
1505 Read_Project_Qualifier
1506 (Env.Flags, In_Tree, Is_Config_File, Qualifier_Location, Project);
1507
1508 Set_Location_Of (Project, In_Tree, Token_Ptr);
1509
1510 Expect (Tok_Project, "PROJECT");
1511
1512 -- Mark location of PROJECT token if present
1513
1514 if Token = Tok_Project then
1515 Scan (In_Tree); -- past PROJECT
1516 Set_Location_Of (Project, In_Tree, Token_Ptr);
1517 end if;
1518
1519 -- Clear the Buffer
1520
1521 Buffer_Last := 0;
1522 loop
1523 Expect (Tok_Identifier, "identifier");
1524
1525 -- If the token is not an identifier, clear the buffer before
1526 -- exiting to indicate that the name of the project is ill-formed.
1527
1528 if Token /= Tok_Identifier then
1529 Buffer_Last := 0;
1530 exit;
1531 end if;
1532
1533 -- Add the identifier name to the buffer
1534
1535 Get_Name_String (Token_Name);
1536 Add_To_Buffer (Name_Buffer (1 .. Name_Len), Buffer, Buffer_Last);
1537
1538 -- Scan past the identifier
1539
1540 Scan (In_Tree);
1541
1542 -- If we have a dot, add a dot to the Buffer and look for the next
1543 -- identifier.
1544
1545 exit when Token /= Tok_Dot;
1546 Add_To_Buffer (".", Buffer, Buffer_Last);
1547
1548 -- Scan past the dot
1549
1550 Scan (In_Tree);
1551 end loop;
1552
1553 -- See if this is an extending project
1554
1555 if Token = Tok_Extends then
1556
1557 if Is_Config_File then
1558 Error_Msg
1559 (Env.Flags,
1560 "extending configuration project not allowed", Token_Ptr);
1561 end if;
1562
1563 -- Make sure that gnatmake will use mapping files
1564
1565 Opt.Create_Mapping_File := True;
1566
1567 -- We are extending another project
1568
1569 Extending := True;
1570
1571 Scan (In_Tree); -- past EXTENDS
1572
1573 if Token = Tok_All then
1574 Extends_All := True;
1575 Set_Is_Extending_All (Project, In_Tree);
1576 Scan (In_Tree); -- scan past ALL
1577 end if;
1578 end if;
1579
1580 -- If the name is well formed, Buffer_Last is > 0
1581
1582 if Buffer_Last > 0 then
1583
1584 -- The Buffer contains the name of the project
1585
1586 Name_Len := Buffer_Last;
1587 Name_Buffer (1 .. Name_Len) := Buffer (1 .. Buffer_Last);
1588 Name_Of_Project := Name_Find;
1589 Set_Name_Of (Project, In_Tree, Name_Of_Project);
1590
1591 -- To get expected name of the project file, replace dots by dashes
1592
1593 for Index in 1 .. Name_Len loop
1594 if Name_Buffer (Index) = '.' then
1595 Name_Buffer (Index) := '-';
1596 end if;
1597 end loop;
1598
1599 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1600
1601 declare
1602 Expected_Name : constant Name_Id := Name_Find;
1603 Extension : String_Access;
1604
1605 begin
1606 -- Output a warning if the actual name is not the expected name
1607
1608 if not Is_Config_File
1609 and then (Name_From_Path /= No_Name)
1610 and then Expected_Name /= Name_From_Path
1611 then
1612 Error_Msg_Name_1 := Expected_Name;
1613
1614 if Is_Config_File then
1615 Extension := new String'(Config_Project_File_Extension);
1616
1617 else
1618 Extension := new String'(Project_File_Extension);
1619 end if;
1620
1621 Error_Msg
1622 (Env.Flags,
1623 "?file name does not match project name, should be `%%"
1624 & Extension.all & "`",
1625 Token_Ptr);
1626 end if;
1627 end;
1628
1629 -- Read the original casing of the project name and put it in the
1630 -- project node.
1631
1632 declare
1633 Loc : Source_Ptr;
1634 begin
1635 Loc := Location_Of (Project, In_Tree);
1636 for J in 1 .. Name_Len loop
1637 Name_Buffer (J) := Sinput.Source (Loc);
1638 Loc := Loc + 1;
1639 end loop;
1640
1641 Set_Display_Name_Of (Project, In_Tree, Name_Find);
1642 end;
1643
1644 declare
1645 From_Ext : Extension_Origin := None;
1646
1647 begin
1648 -- Extending_All is always propagated
1649
1650 if From_Extended = Extending_All or else Extends_All then
1651 From_Ext := Extending_All;
1652
1653 -- Otherwise, From_Extended is set to Extending_Single if the
1654 -- current project is an extending project.
1655
1656 elsif Extended then
1657 From_Ext := Extending_Simple;
1658 end if;
1659
1660 Post_Parse_Context_Clause
1661 (In_Tree => In_Tree,
1662 Context_Clause => First_With,
1663 In_Limited => In_Limited,
1664 Limited_Withs => False,
1665 Imported_Projects => Imported_Projects,
1666 Project_Directory => Project_Directory,
1667 From_Extended => From_Ext,
1668 Packages_To_Check => Packages_To_Check,
1669 Depth => Depth + 1,
1670 Current_Dir => Current_Dir,
1671 Is_Config_File => Is_Config_File,
1672 Env => Env);
1673 Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects);
1674 end;
1675
1676 if not Is_Config_File then
1677 declare
1678 Name_And_Node : Tree_Private_Part.Project_Name_And_Node :=
1679 Tree_Private_Part.Projects_Htable.Get_First
1680 (In_Tree.Projects_HT);
1681 Project_Name : Name_Id := Name_And_Node.Name;
1682
1683 begin
1684 -- Check if we already have a project with this name
1685
1686 while Project_Name /= No_Name
1687 and then Project_Name /= Name_Of_Project
1688 loop
1689 Name_And_Node :=
1690 Tree_Private_Part.Projects_Htable.Get_Next
1691 (In_Tree.Projects_HT);
1692 Project_Name := Name_And_Node.Name;
1693 end loop;
1694
1695 -- Report an error if we already have a project with this name
1696
1697 if Project_Name /= No_Name then
1698 Duplicated := True;
1699 Error_Msg_Name_1 := Project_Name;
1700 Error_Msg
1701 (Env.Flags, "duplicate project name %%",
1702 Location_Of (Project, In_Tree));
1703 Error_Msg_Name_1 :=
1704 Name_Id (Path_Name_Of (Name_And_Node.Node, In_Tree));
1705 Error_Msg
1706 (Env.Flags,
1707 "\already in %%", Location_Of (Project, In_Tree));
1708 end if;
1709 end;
1710 end if;
1711
1712 end if;
1713
1714 if Extending then
1715 Expect (Tok_String_Literal, "literal string");
1716
1717 if Token = Tok_String_Literal then
1718 Set_Extended_Project_Path_Of
1719 (Project,
1720 In_Tree,
1721 Path_Name_Type (Token_Name));
1722
1723 declare
1724 Original_Path_Name : constant String :=
1725 Get_Name_String (Token_Name);
1726
1727 Extended_Project_Path_Name_Id : Path_Name_Type;
1728
1729 begin
1730 Find_Project
1731 (Env.Project_Path,
1732 Project_File_Name => Original_Path_Name,
1733 Directory => Get_Name_String (Project_Directory),
1734 Path => Extended_Project_Path_Name_Id);
1735
1736 if Extended_Project_Path_Name_Id = No_Path then
1737
1738 -- We could not find the project file to extend
1739
1740 Error_Msg_Name_1 := Token_Name;
1741
1742 Error_Msg (Env.Flags, "unknown project file: %%", Token_Ptr);
1743
1744 -- If not in the main project file, display the import path
1745
1746 if Project_Stack.Last > 1 then
1747 Error_Msg_Name_1 :=
1748 Name_Id
1749 (Project_Stack.Table (Project_Stack.Last).Path_Name);
1750 Error_Msg (Env.Flags, "\extended by %%", Token_Ptr);
1751
1752 for Index in reverse 1 .. Project_Stack.Last - 1 loop
1753 Error_Msg_Name_1 :=
1754 Name_Id
1755 (Project_Stack.Table (Index).Path_Name);
1756 Error_Msg (Env.Flags, "\imported by %%", Token_Ptr);
1757 end loop;
1758 end if;
1759
1760 else
1761 declare
1762 From_Ext : Extension_Origin := None;
1763
1764 begin
1765 if From_Extended = Extending_All or else Extends_All then
1766 From_Ext := Extending_All;
1767 end if;
1768
1769 Parse_Single_Project
1770 (In_Tree => In_Tree,
1771 Project => Extended_Project,
1772 Extends_All => Extends_All,
1773 Path_Name_Id => Extended_Project_Path_Name_Id,
1774 Extended => True,
1775 From_Extended => From_Ext,
1776 In_Limited => In_Limited,
1777 Packages_To_Check => Packages_To_Check,
1778 Depth => Depth + 1,
1779 Current_Dir => Current_Dir,
1780 Is_Config_File => Is_Config_File,
1781 Env => Env);
1782 end;
1783
1784 if Present (Extended_Project) then
1785
1786 if Project_Qualifier_Of (Extended_Project, In_Tree) =
1787 Aggregate
1788 then
1789 Error_Msg_Name_1 :=
1790 Name_Id (Path_Name_Of (Extended_Project, In_Tree));
1791 Error_Msg
1792 (Env.Flags,
1793 "cannot extend aggregate project %%",
1794 Location_Of (Project, In_Tree));
1795 end if;
1796
1797 -- A project that extends an extending-all project is
1798 -- also an extending-all project.
1799
1800 if Is_Extending_All (Extended_Project, In_Tree) then
1801 Set_Is_Extending_All (Project, In_Tree);
1802 end if;
1803
1804 -- An abstract project can only extend an abstract
1805 -- project. Otherwise we may have an abstract project
1806 -- with sources if it inherits sources from the project
1807 -- it extends.
1808
1809 if Project_Qualifier_Of (Project, In_Tree) =
1810 Abstract_Project
1811 and then
1812 Project_Qualifier_Of (Extended_Project, In_Tree) /=
1813 Abstract_Project
1814 then
1815 Error_Msg
1816 (Env.Flags, "an abstract project can only extend " &
1817 "another abstract project",
1818 Qualifier_Location);
1819 end if;
1820 end if;
1821 end if;
1822 end;
1823
1824 Scan (In_Tree); -- past the extended project path
1825 end if;
1826 end if;
1827
1828 Check_Extending_All_Imports (Env.Flags, In_Tree, Project);
1829 Check_Aggregate_Imports (Env.Flags, In_Tree, Project);
1830 Check_Import_Aggregate (Env.Flags, In_Tree, Project);
1831
1832 -- Check that a project with a name including a dot either imports
1833 -- or extends the project whose name precedes the last dot.
1834
1835 if Name_Of_Project /= No_Name then
1836 Get_Name_String (Name_Of_Project);
1837
1838 else
1839 Name_Len := 0;
1840 end if;
1841
1842 -- Look for the last dot
1843
1844 while Name_Len > 0 and then Name_Buffer (Name_Len) /= '.' loop
1845 Name_Len := Name_Len - 1;
1846 end loop;
1847
1848 -- If a dot was found, check if parent project is imported or extended
1849
1850 if Name_Len > 0 then
1851 Name_Len := Name_Len - 1;
1852
1853 declare
1854 Parent_Name : constant Name_Id := Name_Find;
1855 Parent_Found : Boolean := False;
1856 Parent_Node : Project_Node_Id := Empty_Node;
1857 With_Clause : Project_Node_Id :=
1858 First_With_Clause_Of (Project, In_Tree);
1859 Imp_Proj_Name : Name_Id;
1860
1861 begin
1862 -- If there is an extended project, check its name
1863
1864 if Present (Extended_Project) then
1865 Parent_Node := Extended_Project;
1866 Parent_Found :=
1867 Name_Of (Extended_Project, In_Tree) = Parent_Name;
1868 end if;
1869
1870 -- If the parent project is not the extended project,
1871 -- check each imported project until we find the parent project.
1872
1873 Imported_Loop :
1874 while not Parent_Found and then Present (With_Clause) loop
1875 Parent_Node := Project_Node_Of (With_Clause, In_Tree);
1876 Extension_Loop : while Present (Parent_Node) loop
1877 Imp_Proj_Name := Name_Of (Parent_Node, In_Tree);
1878 Parent_Found := Imp_Proj_Name = Parent_Name;
1879 exit Imported_Loop when Parent_Found;
1880 Parent_Node :=
1881 Extended_Project_Of
1882 (Project_Declaration_Of (Parent_Node, In_Tree),
1883 In_Tree);
1884 end loop Extension_Loop;
1885
1886 With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
1887 end loop Imported_Loop;
1888
1889 if Parent_Found then
1890 Set_Parent_Project_Of (Project, In_Tree, To => Parent_Node);
1891
1892 else
1893 -- If the parent project was not found, report an error
1894
1895 Error_Msg_Name_1 := Name_Of_Project;
1896 Error_Msg_Name_2 := Parent_Name;
1897 Error_Msg (Env.Flags,
1898 "project %% does not import or extend project %%",
1899 Location_Of (Project, In_Tree));
1900 end if;
1901 end;
1902 end if;
1903
1904 Expect (Tok_Is, "IS");
1905 Set_End_Of_Line (Project);
1906 Set_Previous_Line_Node (Project);
1907 Set_Next_End_Node (Project);
1908
1909 declare
1910 Project_Declaration : Project_Node_Id := Empty_Node;
1911
1912 begin
1913 -- No need to Scan past "is", Prj.Dect.Parse will do it
1914
1915 Prj.Dect.Parse
1916 (In_Tree => In_Tree,
1917 Declarations => Project_Declaration,
1918 Current_Project => Project,
1919 Extends => Extended_Project,
1920 Packages_To_Check => Packages_To_Check,
1921 Is_Config_File => Is_Config_File,
1922 Flags => Env.Flags);
1923 Set_Project_Declaration_Of (Project, In_Tree, Project_Declaration);
1924
1925 if Present (Extended_Project)
1926 and then Project_Qualifier_Of (Extended_Project, In_Tree) /=
1927 Abstract_Project
1928 then
1929 Set_Extending_Project_Of
1930 (Project_Declaration_Of (Extended_Project, In_Tree), In_Tree,
1931 To => Project);
1932 end if;
1933 end;
1934
1935 Expect (Tok_End, "END");
1936 Remove_Next_End_Node;
1937
1938 -- Skip "end" if present
1939
1940 if Token = Tok_End then
1941 Scan (In_Tree);
1942 end if;
1943
1944 -- Clear the Buffer
1945
1946 Buffer_Last := 0;
1947
1948 -- Store the name following "end" in the Buffer. The name may be made of
1949 -- several simple names.
1950
1951 loop
1952 Expect (Tok_Identifier, "identifier");
1953
1954 -- If we don't have an identifier, clear the buffer before exiting to
1955 -- avoid checking the name.
1956
1957 if Token /= Tok_Identifier then
1958 Buffer_Last := 0;
1959 exit;
1960 end if;
1961
1962 -- Add the identifier to the Buffer
1963 Get_Name_String (Token_Name);
1964 Add_To_Buffer (Name_Buffer (1 .. Name_Len), Buffer, Buffer_Last);
1965
1966 -- Scan past the identifier
1967
1968 Scan (In_Tree);
1969 exit when Token /= Tok_Dot;
1970 Add_To_Buffer (".", Buffer, Buffer_Last);
1971 Scan (In_Tree);
1972 end loop;
1973
1974 -- If we have a valid name, check if it is the name of the project
1975
1976 if Name_Of_Project /= No_Name and then Buffer_Last > 0 then
1977 if To_Lower (Buffer (1 .. Buffer_Last)) /=
1978 Get_Name_String (Name_Of (Project, In_Tree))
1979 then
1980 -- Invalid name: report an error
1981
1982 Error_Msg (Env.Flags, "expected """ &
1983 Get_Name_String (Name_Of (Project, In_Tree)) & """",
1984 Token_Ptr);
1985 end if;
1986 end if;
1987
1988 Expect (Tok_Semicolon, "`;`");
1989
1990 -- Check that there is no more text following the end of the project
1991 -- source.
1992
1993 if Token = Tok_Semicolon then
1994 Set_Previous_End_Node (Project);
1995 Scan (In_Tree);
1996
1997 if Token /= Tok_EOF then
1998 Error_Msg
1999 (Env.Flags,
2000 "unexpected text following end of project", Token_Ptr);
2001 end if;
2002 end if;
2003
2004 if not Duplicated and then Name_Of_Project /= No_Name then
2005
2006 -- Add the name of the project to the hash table, so that we can
2007 -- check that no other subsequent project will have the same name.
2008
2009 Tree_Private_Part.Projects_Htable.Set
2010 (T => In_Tree.Projects_HT,
2011 K => Name_Of_Project,
2012 E => (Name => Name_Of_Project,
2013 Node => Project,
2014 Resolved_Path => Resolved_Path_Name,
2015 Extended => Extended,
2016 From_Extended => From_Extended /= None,
2017 Proj_Qualifier => Project_Qualifier_Of (Project, In_Tree)));
2018 end if;
2019
2020 declare
2021 From_Ext : Extension_Origin := None;
2022
2023 begin
2024 -- Extending_All is always propagated
2025
2026 if From_Extended = Extending_All or else Extends_All then
2027 From_Ext := Extending_All;
2028
2029 -- Otherwise, From_Extended is set to Extending_Single if the
2030 -- current project is an extending project.
2031
2032 elsif Extended then
2033 From_Ext := Extending_Simple;
2034 end if;
2035
2036 Post_Parse_Context_Clause
2037 (In_Tree => In_Tree,
2038 Context_Clause => First_With,
2039 In_Limited => In_Limited,
2040 Limited_Withs => True,
2041 Imported_Projects => Imported_Projects,
2042 Project_Directory => Project_Directory,
2043 From_Extended => From_Ext,
2044 Packages_To_Check => Packages_To_Check,
2045 Depth => Depth + 1,
2046 Current_Dir => Current_Dir,
2047 Is_Config_File => Is_Config_File,
2048 Env => Env);
2049 Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects);
2050 end;
2051
2052 -- Restore the scan state, in case we are not the main project
2053
2054 Restore_Project_Scan_State (Project_Scan_State);
2055
2056 -- And remove the project from the project stack
2057
2058 Project_Stack.Decrement_Last;
2059
2060 -- Indicate if there are unkept comments
2061
2062 Tree.Set_Project_File_Includes_Unkept_Comments
2063 (Node => Project,
2064 In_Tree => In_Tree,
2065 To => Tree.There_Are_Unkept_Comments);
2066
2067 -- And restore the comment state that was saved
2068
2069 Tree.Restore_And_Free (Project_Comment_State);
2070
2071 Debug_Decrease_Indent;
2072
2073 if Project /= Empty_Node and then Implicit_Project then
2074 Name_Len := 0;
2075 Add_Str_To_Name_Buffer (Current_Dir);
2076 Add_Char_To_Name_Buffer (Dir_Sep);
2077 In_Tree.Project_Nodes.Table (Project).Directory := Name_Find;
2078 end if;
2079 end Parse_Single_Project;
2080
2081 -----------------------
2082 -- Project_Name_From --
2083 -----------------------
2084
2085 function Project_Name_From
2086 (Path_Name : String;
2087 Is_Config_File : Boolean) return Name_Id
2088 is
2089 Canonical : String (1 .. Path_Name'Length) := Path_Name;
2090 First : Natural := Canonical'Last;
2091 Last : Natural := First;
2092 Index : Positive;
2093
2094 begin
2095 if Current_Verbosity = High then
2096 Debug_Output ("Project_Name_From (""" & Canonical & """)");
2097 end if;
2098
2099 -- If the path name is empty, return No_Name to indicate failure
2100
2101 if First = 0 then
2102 return No_Name;
2103 end if;
2104
2105 Canonical_Case_File_Name (Canonical);
2106
2107 -- Look for the last dot in the path name
2108
2109 while First > 0
2110 and then
2111 Canonical (First) /= '.'
2112 loop
2113 First := First - 1;
2114 end loop;
2115
2116 -- If we have a dot, check that it is followed by the correct extension
2117
2118 if First > 0 and then Canonical (First) = '.' then
2119 if (not Is_Config_File
2120 and then Canonical (First .. Last) = Project_File_Extension
2121 and then First /= 1)
2122 or else
2123 (Is_Config_File
2124 and then
2125 Canonical (First .. Last) = Config_Project_File_Extension
2126 and then First /= 1)
2127 then
2128 -- Look for the last directory separator, if any
2129
2130 First := First - 1;
2131 Last := First;
2132 while First > 0
2133 and then Canonical (First) /= '/'
2134 and then Canonical (First) /= Dir_Sep
2135 loop
2136 First := First - 1;
2137 end loop;
2138
2139 else
2140 -- Not the correct extension, return No_Name to indicate failure
2141
2142 return No_Name;
2143 end if;
2144
2145 -- If no dot in the path name, return No_Name to indicate failure
2146
2147 else
2148 return No_Name;
2149 end if;
2150
2151 First := First + 1;
2152
2153 -- If the extension is the file name, return No_Name to indicate failure
2154
2155 if First > Last then
2156 return No_Name;
2157 end if;
2158
2159 -- Put the name in lower case into Name_Buffer
2160
2161 Name_Len := Last - First + 1;
2162 Name_Buffer (1 .. Name_Len) := To_Lower (Canonical (First .. Last));
2163
2164 Index := 1;
2165
2166 -- Check if it is a well formed project name. Return No_Name if it is
2167 -- ill formed.
2168
2169 loop
2170 if not Is_Letter (Name_Buffer (Index)) then
2171 return No_Name;
2172
2173 else
2174 loop
2175 Index := Index + 1;
2176
2177 exit when Index >= Name_Len;
2178
2179 if Name_Buffer (Index) = '_' then
2180 if Name_Buffer (Index + 1) = '_' then
2181 return No_Name;
2182 end if;
2183 end if;
2184
2185 exit when Name_Buffer (Index) = '-';
2186
2187 if Name_Buffer (Index) /= '_'
2188 and then not Is_Alphanumeric (Name_Buffer (Index))
2189 then
2190 return No_Name;
2191 end if;
2192
2193 end loop;
2194 end if;
2195
2196 if Index >= Name_Len then
2197 if Is_Alphanumeric (Name_Buffer (Name_Len)) then
2198
2199 -- All checks have succeeded. Return name in Name_Buffer
2200
2201 return Name_Find;
2202
2203 else
2204 return No_Name;
2205 end if;
2206
2207 elsif Name_Buffer (Index) = '-' then
2208 Index := Index + 1;
2209 end if;
2210 end loop;
2211 end Project_Name_From;
2212
2213 end Prj.Part;
Mirror of the offical gcc git repository hosted at gcc.gnu.org