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