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