1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2001-2004 Free Software Foundation, Inc. --
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. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
27 with Err_Vars
; use Err_Vars
;
28 with Namet
; use Namet
;
30 with Osint
; use Osint
;
31 with Output
; use Output
;
32 with Prj
.Com
; use Prj
.Com
;
34 with Prj
.Err
; use Prj
.Err
;
35 with Scans
; use Scans
;
36 with Sinput
; use Sinput
;
37 with Sinput
.P
; use Sinput
.P
;
40 with Types
; use Types
;
42 with Ada
.Characters
.Handling
; use Ada
.Characters
.Handling
;
43 with Ada
.Exceptions
; use Ada
.Exceptions
;
45 with GNAT
.Directory_Operations
; use GNAT
.Directory_Operations
;
46 with GNAT
.OS_Lib
; use GNAT
.OS_Lib
;
48 with System
.HTable
; use System
.HTable
;
50 pragma Elaborate_All
(GNAT
.OS_Lib
);
52 package body Prj
.Part
is
54 Dir_Sep
: Character renames GNAT
.OS_Lib
.Directory_Separator
;
56 Project_Path
: String_Access
;
57 -- The project path; initialized during package elaboration.
58 -- Contains at least the current working directory.
60 Ada_Project_Path
: constant String := "ADA_PROJECT_PATH";
61 -- Name of the env. variable that contains path name(s) of directories
62 -- where project files may reside.
64 Prj_Path
: constant String_Access
:= Getenv
(Ada_Project_Path
);
65 -- The path name(s) of directories where project files may reside.
68 type Extension_Origin
is (None
, Extending_Simple
, Extending_All
);
69 -- Type of parameter From_Extended for procedures Parse_Single_Project and
70 -- Post_Parse_Context_Clause. Extending_All means that we are parsing the
71 -- tree rooted at an extending all project.
73 ------------------------------------
74 -- Local Packages and Subprograms --
75 ------------------------------------
77 type With_Id
is new Nat
;
78 No_With
: constant With_Id
:= 0;
80 type With_Record
is record
82 Location
: Source_Ptr
;
83 Limited_With
: Boolean;
84 Node
: Project_Node_Id
;
87 -- Information about an imported project, to be put in table Withs below
89 package Withs
is new Table
.Table
90 (Table_Component_Type
=> With_Record
,
91 Table_Index_Type
=> With_Id
,
94 Table_Increment
=> 50,
95 Table_Name
=> "Prj.Part.Withs");
96 -- Table used to store temporarily paths and locations of imported
97 -- projects. These imported projects will be effectively parsed after the
98 -- name of the current project has been extablished.
100 type Names_And_Id
is record
102 Canonical_Path_Name
: Name_Id
;
103 Id
: Project_Node_Id
;
106 package Project_Stack
is new Table
.Table
107 (Table_Component_Type
=> Names_And_Id
,
108 Table_Index_Type
=> Nat
,
109 Table_Low_Bound
=> 1,
111 Table_Increment
=> 50,
112 Table_Name
=> "Prj.Part.Project_Stack");
113 -- This table is used to detect circular dependencies
114 -- for imported and extended projects and to get the project ids of
115 -- limited imported projects when there is a circularity with at least
116 -- one limited imported project file.
118 package Virtual_Hash
is new Simple_HTable
119 (Header_Num
=> Header_Num
,
120 Element
=> Project_Node_Id
,
121 No_Element
=> Empty_Node
,
122 Key
=> Project_Node_Id
,
123 Hash
=> Prj
.Tree
.Hash
,
125 -- Hash table to store the node id of the project for which a virtual
126 -- extending project need to be created.
128 package Processed_Hash
is new Simple_HTable
129 (Header_Num
=> Header_Num
,
132 Key
=> Project_Node_Id
,
133 Hash
=> Prj
.Tree
.Hash
,
135 -- Hash table to store the project process when looking for project that
136 -- need to have a virtual extending project, to avoid processing the same
139 procedure Create_Virtual_Extending_Project
140 (For_Project
: Project_Node_Id
;
141 Main_Project
: Project_Node_Id
);
142 -- Create a virtual extending project of For_Project. Main_Project is
143 -- the extending all project.
145 procedure Look_For_Virtual_Projects_For
146 (Proj
: Project_Node_Id
;
147 Potentially_Virtual
: Boolean);
148 -- Look for projects that need to have a virtual extending project.
149 -- This procedure is recursive. If called with Potentially_Virtual set to
150 -- True, then Proj may need an virtual extending project; otherwise it
151 -- does not (because it is already extended), but other projects that it
152 -- imports may need to be virtually extended.
154 procedure Pre_Parse_Context_Clause
(Context_Clause
: out With_Id
);
155 -- Parse the context clause of a project.
156 -- Store the paths and locations of the imported projects in table Withs.
157 -- Does nothing if there is no context clause (if the current
158 -- token is not "with" or "limited" followed by "with").
160 procedure Post_Parse_Context_Clause
161 (Context_Clause
: With_Id
;
162 Imported_Projects
: out Project_Node_Id
;
163 Project_Directory
: Name_Id
;
164 From_Extended
: Extension_Origin
;
165 In_Limited
: Boolean);
166 -- Parse the imported projects that have been stored in table Withs,
167 -- if any. From_Extended is used for the call to Parse_Single_Project
168 -- below. When In_Limited is True, the importing path includes at least
169 -- one "limited with".
171 procedure Parse_Single_Project
172 (Project
: out Project_Node_Id
;
173 Extends_All
: out Boolean;
176 From_Extended
: Extension_Origin
;
177 In_Limited
: Boolean);
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".
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.
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.
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.
201 --------------------------------------
202 -- Create_Virtual_Extending_Project --
203 --------------------------------------
205 procedure Create_Virtual_Extending_Project
206 (For_Project
: Project_Node_Id
;
207 Main_Project
: Project_Node_Id
)
210 Virtual_Name
: constant String :=
212 Get_Name_String
(Name_Of
(For_Project
));
213 -- The name of the virtual extending project
215 Virtual_Name_Id
: Name_Id
;
216 -- Virtual extending project name id
218 Virtual_Path_Id
: Name_Id
;
219 -- Fake path name of the virtual extending project. The directory is
220 -- the same directory as the extending all project.
222 Virtual_Dir_Id
: constant Name_Id
:=
223 Immediate_Directory_Of
(Path_Name_Of
(Main_Project
));
224 -- The directory of the extending all project
226 -- The source of the virtual extending project is something like:
228 -- project V$<project name> extends <project path> is
230 -- for Source_Dirs use ();
232 -- end V$<project name>;
234 -- The project directory cannot be specified during parsing; it will be
235 -- put directly in the virtual extending project data during processing.
237 -- Nodes that made up the virtual extending project
239 Virtual_Project
: constant Project_Node_Id
:=
240 Default_Project_Node
(N_Project
);
241 With_Clause
: constant Project_Node_Id
:=
242 Default_Project_Node
(N_With_Clause
);
243 Project_Declaration
: constant Project_Node_Id
:=
244 Default_Project_Node
(N_Project_Declaration
);
245 Source_Dirs_Declaration
: constant Project_Node_Id
:=
246 Default_Project_Node
(N_Declarative_Item
);
247 Source_Dirs_Attribute
: constant Project_Node_Id
:=
249 (N_Attribute_Declaration
, List
);
250 Source_Dirs_Expression
: constant Project_Node_Id
:=
251 Default_Project_Node
(N_Expression
, List
);
252 Source_Dirs_Term
: constant Project_Node_Id
:=
253 Default_Project_Node
(N_Term
, List
);
254 Source_Dirs_List
: constant Project_Node_Id
:=
256 (N_Literal_String_List
, List
);
259 -- Get the virtual name id
261 Name_Len
:= Virtual_Name
'Length;
262 Name_Buffer
(1 .. Name_Len
) := Virtual_Name
;
263 Virtual_Name_Id
:= Name_Find
;
265 -- Get the virtual path name
267 Get_Name_String
(Path_Name_Of
(Main_Project
));
270 and then Name_Buffer
(Name_Len
) /= Directory_Separator
271 and then Name_Buffer
(Name_Len
) /= '/'
273 Name_Len
:= Name_Len
- 1;
276 Name_Buffer
(Name_Len
+ 1 .. Name_Len
+ Virtual_Name
'Length) :=
278 Name_Len
:= Name_Len
+ Virtual_Name
'Length;
279 Virtual_Path_Id
:= Name_Find
;
283 Set_Name_Of
(With_Clause
, Virtual_Name_Id
);
284 Set_Path_Name_Of
(With_Clause
, Virtual_Path_Id
);
285 Set_Project_Node_Of
(With_Clause
, Virtual_Project
);
286 Set_Next_With_Clause_Of
287 (With_Clause
, First_With_Clause_Of
(Main_Project
));
288 Set_First_With_Clause_Of
(Main_Project
, With_Clause
);
290 -- Virtual project node
292 Set_Name_Of
(Virtual_Project
, Virtual_Name_Id
);
293 Set_Path_Name_Of
(Virtual_Project
, Virtual_Path_Id
);
294 Set_Location_Of
(Virtual_Project
, Location_Of
(Main_Project
));
295 Set_Directory_Of
(Virtual_Project
, Virtual_Dir_Id
);
296 Set_Project_Declaration_Of
(Virtual_Project
, Project_Declaration
);
297 Set_Extended_Project_Path_Of
298 (Virtual_Project
, Path_Name_Of
(For_Project
));
300 -- Project declaration
302 Set_First_Declarative_Item_Of
303 (Project_Declaration
, Source_Dirs_Declaration
);
304 Set_Extended_Project_Of
(Project_Declaration
, For_Project
);
306 -- Source_Dirs declaration
308 Set_Current_Item_Node
(Source_Dirs_Declaration
, Source_Dirs_Attribute
);
310 -- Source_Dirs attribute
312 Set_Name_Of
(Source_Dirs_Attribute
, Snames
.Name_Source_Dirs
);
313 Set_Expression_Of
(Source_Dirs_Attribute
, Source_Dirs_Expression
);
315 -- Source_Dirs expression
317 Set_First_Term
(Source_Dirs_Expression
, Source_Dirs_Term
);
321 Set_Current_Term
(Source_Dirs_Term
, Source_Dirs_List
);
323 -- Source_Dirs empty list: nothing to do
325 end Create_Virtual_Extending_Project
;
327 ----------------------------
328 -- Immediate_Directory_Of --
329 ----------------------------
331 function Immediate_Directory_Of
(Path_Name
: Name_Id
) return Name_Id
is
333 Get_Name_String
(Path_Name
);
335 for Index
in reverse 1 .. Name_Len
loop
336 if Name_Buffer
(Index
) = '/'
337 or else Name_Buffer
(Index
) = Dir_Sep
339 -- Remove all chars after last directory separator from name
342 Name_Len
:= Index
- 1;
352 -- There is no directory separator in name. Return "./" or ".\"
355 Name_Buffer
(1) := '.';
356 Name_Buffer
(2) := Dir_Sep
;
358 end Immediate_Directory_Of
;
360 -----------------------------------
361 -- Look_For_Virtual_Projects_For --
362 -----------------------------------
364 procedure Look_For_Virtual_Projects_For
365 (Proj
: Project_Node_Id
;
366 Potentially_Virtual
: Boolean)
369 Declaration
: Project_Node_Id
:= Empty_Node
;
370 -- Node for the project declaration of Proj
372 With_Clause
: Project_Node_Id
:= Empty_Node
;
373 -- Node for a with clause of Proj
375 Imported
: Project_Node_Id
:= Empty_Node
;
376 -- Node for a project imported by Proj
378 Extended
: Project_Node_Id
:= Empty_Node
;
379 -- Node for the eventual project extended by Proj
382 -- Nothing to do if Proj is not defined or if it has already been
385 if Proj
/= Empty_Node
and then not Processed_Hash
.Get
(Proj
) then
386 -- Make sure the project will not be processed again
388 Processed_Hash
.Set
(Proj
, True);
390 Declaration
:= Project_Declaration_Of
(Proj
);
392 if Declaration
/= Empty_Node
then
393 Extended
:= Extended_Project_Of
(Declaration
);
396 -- If this is a project that may need a virtual extending project
397 -- and it is not itself an extending project, put it in the list.
399 if Potentially_Virtual
and then Extended
= Empty_Node
then
400 Virtual_Hash
.Set
(Proj
, Proj
);
403 -- Now check the projects it imports
405 With_Clause
:= First_With_Clause_Of
(Proj
);
407 while With_Clause
/= Empty_Node
loop
408 Imported
:= Project_Node_Of
(With_Clause
);
410 if Imported
/= Empty_Node
then
411 Look_For_Virtual_Projects_For
412 (Imported
, Potentially_Virtual
=> True);
415 With_Clause
:= Next_With_Clause_Of
(With_Clause
);
418 -- Check also the eventual project extended by Proj. As this project
419 -- is already extended, call recursively with Potentially_Virtual
422 Look_For_Virtual_Projects_For
423 (Extended
, Potentially_Virtual
=> False);
425 end Look_For_Virtual_Projects_For
;
432 (Project
: out Project_Node_Id
;
433 Project_File_Name
: String;
434 Always_Errout_Finalize
: Boolean;
435 Packages_To_Check
: String_List_Access
:= All_Packages
;
436 Store_Comments
: Boolean := False)
438 Current_Directory
: constant String := Get_Current_Dir
;
442 -- Save the Packages_To_Check in Prj, so that it is visible from
445 Current_Packages_To_Check
:= Packages_To_Check
;
447 Project
:= Empty_Node
;
449 if Current_Verbosity
>= Medium
then
450 Write_Str
("ADA_PROJECT_PATH=""");
451 Write_Str
(Project_Path
.all);
456 Path_Name
: constant String :=
457 Project_Path_Name_Of
(Project_File_Name
,
458 Directory
=> Current_Directory
);
462 Prj
.Err
.Scanner
.Set_Comment_As_Token
(Store_Comments
);
463 Prj
.Err
.Scanner
.Set_End_Of_Line_As_Token
(Store_Comments
);
465 -- Parse the main project file
467 if Path_Name
= "" then
469 ("project file """, Project_File_Name
, """ not found");
470 Project
:= Empty_Node
;
476 Extends_All
=> Dummy
,
477 Path_Name
=> Path_Name
,
479 From_Extended
=> None
,
480 In_Limited
=> False);
482 -- If Project is an extending-all project, create the eventual
483 -- virtual extending projects and check that there are no illegally
484 -- imported projects.
486 if Project
/= Empty_Node
and then Is_Extending_All
(Project
) then
487 -- First look for projects that potentially need a virtual
488 -- extending project.
491 Processed_Hash
.Reset
;
493 -- Mark the extending all project as processed, to avoid checking
494 -- the imported projects in case of a "limited with" on this
495 -- extending all project.
497 Processed_Hash
.Set
(Project
, True);
500 Declaration
: constant Project_Node_Id
:=
501 Project_Declaration_Of
(Project
);
503 Look_For_Virtual_Projects_For
504 (Extended_Project_Of
(Declaration
),
505 Potentially_Virtual
=> False);
508 -- Now, check the projects directly imported by the main project.
509 -- Remove from the potentially virtual any project extended by one
510 -- of these imported projects. For non extending imported
511 -- projects, check that they do not belong to the project tree of
512 -- the project being "extended-all" by the main project.
515 With_Clause
: Project_Node_Id
:=
516 First_With_Clause_Of
(Project
);
517 Imported
: Project_Node_Id
:= Empty_Node
;
518 Declaration
: Project_Node_Id
:= Empty_Node
;
521 while With_Clause
/= Empty_Node
loop
522 Imported
:= Project_Node_Of
(With_Clause
);
524 if Imported
/= Empty_Node
then
525 Declaration
:= Project_Declaration_Of
(Imported
);
527 if Extended_Project_Of
(Declaration
) /= Empty_Node
then
529 Imported
:= Extended_Project_Of
(Declaration
);
530 exit when Imported
= Empty_Node
;
531 Virtual_Hash
.Remove
(Imported
);
532 Declaration
:= Project_Declaration_Of
(Imported
);
535 elsif Virtual_Hash
.Get
(Imported
) /= Empty_Node
then
537 ("this project cannot be imported directly",
538 Location_Of
(With_Clause
));
543 With_Clause
:= Next_With_Clause_Of
(With_Clause
);
547 -- Now create all the virtual extending projects
550 Proj
: Project_Node_Id
:= Virtual_Hash
.Get_First
;
552 while Proj
/= Empty_Node
loop
553 Create_Virtual_Extending_Project
(Proj
, Project
);
554 Proj
:= Virtual_Hash
.Get_Next
;
559 -- If there were any kind of error during the parsing, serious
560 -- or not, then the parsing fails.
562 if Err_Vars
.Total_Errors_Detected
> 0 then
563 Project
:= Empty_Node
;
566 if Project
= Empty_Node
or else Always_Errout_Finalize
then
576 Write_Line
(Exception_Information
(X
));
577 Write_Str
("Exception ");
578 Write_Str
(Exception_Name
(X
));
579 Write_Line
(" raised, while processing project file");
580 Project
:= Empty_Node
;
583 ------------------------------
584 -- Pre_Parse_Context_Clause --
585 ------------------------------
587 procedure Pre_Parse_Context_Clause
(Context_Clause
: out With_Id
) is
588 Current_With_Clause
: With_Id
:= No_With
;
589 Limited_With
: Boolean := False;
591 Current_With
: With_Record
;
593 Current_With_Node
: Project_Node_Id
:= Empty_Node
;
596 -- Assume no context clause
598 Context_Clause
:= No_With
;
601 -- If Token is not WITH or LIMITED, there is no context clause,
602 -- or we have exhausted the with clauses.
604 while Token
= Tok_With
or else Token
= Tok_Limited
loop
605 Current_With_Node
:= Default_Project_Node
(Of_Kind
=> N_With_Clause
);
606 Limited_With
:= Token
= Tok_Limited
;
609 Scan
; -- scan past LIMITED
610 Expect
(Tok_With
, "WITH");
611 exit With_Loop
when Token
/= Tok_With
;
616 Scan
; -- scan past WITH or ","
618 Expect
(Tok_String_Literal
, "literal string");
620 if Token
/= Tok_String_Literal
then
624 -- Store path and location in table Withs
628 Location
=> Token_Ptr
,
629 Limited_With
=> Limited_With
,
630 Node
=> Current_With_Node
,
633 Withs
.Increment_Last
;
634 Withs
.Table
(Withs
.Last
) := Current_With
;
636 if Current_With_Clause
= No_With
then
637 Context_Clause
:= Withs
.Last
;
640 Withs
.Table
(Current_With_Clause
).Next
:= Withs
.Last
;
643 Current_With_Clause
:= Withs
.Last
;
647 if Token
= Tok_Semicolon
then
648 Set_End_Of_Line
(Current_With_Node
);
649 Set_Previous_Line_Node
(Current_With_Node
);
651 -- End of (possibly multiple) with clause;
653 Scan
; -- scan past the semicolon.
656 elsif Token
/= Tok_Comma
then
657 Error_Msg
("expected comma or semi colon", Token_Ptr
);
662 Default_Project_Node
(Of_Kind
=> N_With_Clause
);
665 end Pre_Parse_Context_Clause
;
668 -------------------------------
669 -- Post_Parse_Context_Clause --
670 -------------------------------
672 procedure Post_Parse_Context_Clause
673 (Context_Clause
: With_Id
;
674 Imported_Projects
: out Project_Node_Id
;
675 Project_Directory
: Name_Id
;
676 From_Extended
: Extension_Origin
;
677 In_Limited
: Boolean)
679 Current_With_Clause
: With_Id
:= Context_Clause
;
681 Current_Project
: Project_Node_Id
:= Empty_Node
;
682 Previous_Project
: Project_Node_Id
:= Empty_Node
;
683 Next_Project
: Project_Node_Id
:= Empty_Node
;
685 Project_Directory_Path
: constant String :=
686 Get_Name_String
(Project_Directory
);
688 Current_With
: With_Record
;
689 Limited_With
: Boolean := False;
690 Extends_All
: Boolean := False;
693 Imported_Projects
:= Empty_Node
;
695 while Current_With_Clause
/= No_With
loop
696 Current_With
:= Withs
.Table
(Current_With_Clause
);
697 Current_With_Clause
:= Current_With
.Next
;
699 Limited_With
:= In_Limited
or Current_With
.Limited_With
;
702 Original_Path
: constant String :=
703 Get_Name_String
(Current_With
.Path
);
705 Imported_Path_Name
: constant String :=
708 Project_Directory_Path
);
710 Withed_Project
: Project_Node_Id
:= Empty_Node
;
713 if Imported_Path_Name
= "" then
715 -- The project file cannot be found
717 Error_Msg_Name_1
:= Current_With
.Path
;
719 Error_Msg
("unknown project file: {", Current_With
.Location
);
721 -- If this is not imported by the main project file,
722 -- display the import path.
724 if Project_Stack
.Last
> 1 then
725 for Index
in reverse 1 .. Project_Stack
.Last
loop
726 Error_Msg_Name_1
:= Project_Stack
.Table
(Index
).Path_Name
;
727 Error_Msg
("\imported by {", Current_With
.Location
);
734 Previous_Project
:= Current_Project
;
736 if Current_Project
= Empty_Node
then
738 -- First with clause of the context clause
740 Current_Project
:= Current_With
.Node
;
741 Imported_Projects
:= Current_Project
;
744 Next_Project
:= Current_With
.Node
;
745 Set_Next_With_Clause_Of
(Current_Project
, Next_Project
);
746 Current_Project
:= Next_Project
;
750 (Current_Project
, Current_With
.Path
);
751 Set_Location_Of
(Current_Project
, Current_With
.Location
);
753 -- If this is a "limited with", check if we have
754 -- a circularity; if we have one, get the project id
755 -- of the limited imported project file, and don't
758 if Limited_With
and then Project_Stack
.Last
> 1 then
760 Normed
: constant String :=
761 Normalize_Pathname
(Imported_Path_Name
);
762 Canonical_Path_Name
: Name_Id
;
765 Name_Len
:= Normed
'Length;
766 Name_Buffer
(1 .. Name_Len
) := Normed
;
767 Canonical_Case_File_Name
(Name_Buffer
(1 .. Name_Len
));
768 Canonical_Path_Name
:= Name_Find
;
770 for Index
in 1 .. Project_Stack
.Last
loop
771 if Project_Stack
.Table
(Index
).Canonical_Path_Name
=
774 -- We have found the limited imported project,
775 -- get its project id, and do not parse it.
777 Withed_Project
:= Project_Stack
.Table
(Index
).Id
;
784 -- Parse the imported project, if its project id is unknown
786 if Withed_Project
= Empty_Node
then
788 (Project
=> Withed_Project
,
789 Extends_All
=> Extends_All
,
790 Path_Name
=> Imported_Path_Name
,
792 From_Extended
=> From_Extended
,
793 In_Limited
=> Limited_With
);
796 Extends_All
:= Is_Extending_All
(Withed_Project
);
799 if Withed_Project
= Empty_Node
then
800 -- If parsing was not successful, remove the
803 Current_Project
:= Previous_Project
;
805 if Current_Project
= Empty_Node
then
806 Imported_Projects
:= Empty_Node
;
809 Set_Next_With_Clause_Of
810 (Current_Project
, Empty_Node
);
813 -- If parsing was successful, record project name
814 -- and path name in with clause
817 (Node
=> Current_Project
,
818 To
=> Withed_Project
,
819 Limited_With
=> Limited_With
);
820 Set_Name_Of
(Current_Project
, Name_Of
(Withed_Project
));
821 Name_Len
:= Imported_Path_Name
'Length;
822 Name_Buffer
(1 .. Name_Len
) := Imported_Path_Name
;
823 Set_Path_Name_Of
(Current_Project
, Name_Find
);
826 Set_Is_Extending_All
(Current_Project
);
832 end Post_Parse_Context_Clause
;
834 --------------------------
835 -- Parse_Single_Project --
836 --------------------------
838 procedure Parse_Single_Project
839 (Project
: out Project_Node_Id
;
840 Extends_All
: out Boolean;
843 From_Extended
: Extension_Origin
;
844 In_Limited
: Boolean)
846 Normed_Path_Name
: Name_Id
;
847 Canonical_Path_Name
: Name_Id
;
848 Project_Directory
: Name_Id
;
849 Project_Scan_State
: Saved_Project_Scan_State
;
850 Source_Index
: Source_File_Index
;
852 Extending
: Boolean := False;
854 Extended_Project
: Project_Node_Id
:= Empty_Node
;
856 A_Project_Name_And_Node
: Tree_Private_Part
.Project_Name_And_Node
:=
857 Tree_Private_Part
.Projects_Htable
.Get_First
;
859 Name_From_Path
: constant Name_Id
:= Project_Name_From
(Path_Name
);
861 Name_Of_Project
: Name_Id
:= No_Name
;
863 First_With
: With_Id
;
865 use Tree_Private_Part
;
867 Project_Comment_State
: Tree
.Comment_State
;
870 Extends_All
:= False;
873 Normed_Path
: constant String := Normalize_Pathname
874 (Path_Name
, Resolve_Links
=> False,
875 Case_Sensitive
=> True);
876 Canonical_Path
: constant String := Normalize_Pathname
877 (Normed_Path
, Resolve_Links
=> True,
878 Case_Sensitive
=> False);
881 Name_Len
:= Normed_Path
'Length;
882 Name_Buffer
(1 .. Name_Len
) := Normed_Path
;
883 Normed_Path_Name
:= Name_Find
;
884 Name_Len
:= Canonical_Path
'Length;
885 Name_Buffer
(1 .. Name_Len
) := Canonical_Path
;
886 Canonical_Path_Name
:= Name_Find
;
889 -- Check for a circular dependency
891 for Index
in 1 .. Project_Stack
.Last
loop
892 if Canonical_Path_Name
=
893 Project_Stack
.Table
(Index
).Canonical_Path_Name
895 Error_Msg
("circular dependency detected", Token_Ptr
);
896 Error_Msg_Name_1
:= Normed_Path_Name
;
897 Error_Msg
("\ { is imported by", Token_Ptr
);
899 for Current
in reverse 1 .. Project_Stack
.Last
loop
900 Error_Msg_Name_1
:= Project_Stack
.Table
(Current
).Path_Name
;
902 if Project_Stack
.Table
(Current
).Canonical_Path_Name
/=
906 ("\ { which itself is imported by", Token_Ptr
);
909 Error_Msg
("\ {", Token_Ptr
);
914 Project
:= Empty_Node
;
919 -- Put the new path name on the stack
921 Project_Stack
.Increment_Last
;
922 Project_Stack
.Table
(Project_Stack
.Last
).Path_Name
:= Normed_Path_Name
;
923 Project_Stack
.Table
(Project_Stack
.Last
).Canonical_Path_Name
:=
926 -- Check if the project file has already been parsed.
929 A_Project_Name_And_Node
/= Tree_Private_Part
.No_Project_Name_And_Node
932 Path_Id
: Name_Id
:= Path_Name_Of
(A_Project_Name_And_Node
.Node
);
935 if Path_Id
/= No_Name
then
936 Get_Name_String
(Path_Id
);
937 Canonical_Case_File_Name
(Name_Buffer
(1 .. Name_Len
));
938 Path_Id
:= Name_Find
;
941 if Path_Id
= Canonical_Path_Name
then
944 if A_Project_Name_And_Node
.Extended
then
946 ("cannot extend the same project file several times",
951 ("cannot extend an already imported project file",
955 elsif A_Project_Name_And_Node
.Extended
then
957 Is_Extending_All
(A_Project_Name_And_Node
.Node
);
959 -- If the imported project is an extended project A,
960 -- and we are in an extended project, replace A with the
961 -- ultimate project extending A.
963 if From_Extended
/= None
then
965 Decl
: Project_Node_Id
:=
966 Project_Declaration_Of
967 (A_Project_Name_And_Node
.Node
);
969 Prj
: Project_Node_Id
:=
970 Extending_Project_Of
(Decl
);
974 Decl
:= Project_Declaration_Of
(Prj
);
975 exit when Extending_Project_Of
(Decl
) = Empty_Node
;
976 Prj
:= Extending_Project_Of
(Decl
);
979 A_Project_Name_And_Node
.Node
:= Prj
;
983 ("cannot import an already extended project file",
988 Project
:= A_Project_Name_And_Node
.Node
;
989 Project_Stack
.Decrement_Last
;
994 A_Project_Name_And_Node
:= Tree_Private_Part
.Projects_Htable
.Get_Next
;
997 -- We never encountered this project file
998 -- Save the scan state, load the project file and start to scan it.
1000 Save_Project_Scan_State
(Project_Scan_State
);
1001 Source_Index
:= Load_Project_File
(Path_Name
);
1002 Tree
.Save
(Project_Comment_State
);
1004 -- If we cannot find it, we stop
1006 if Source_Index
= No_Source_File
then
1007 Project
:= Empty_Node
;
1008 Project_Stack
.Decrement_Last
;
1012 Prj
.Err
.Scanner
.Initialize_Scanner
(Types
.No_Unit
, Source_Index
);
1016 if Name_From_Path
= No_Name
then
1018 -- The project file name is not correct (no or bad extension,
1019 -- or not following Ada identifier's syntax).
1021 Error_Msg_Name_1
:= Canonical_Path_Name
;
1022 Error_Msg
("?{ is not a valid path name for a project file",
1026 if Current_Verbosity
>= Medium
then
1027 Write_Str
("Parsing """);
1028 Write_Str
(Path_Name
);
1033 -- Is there any imported project?
1035 Pre_Parse_Context_Clause
(First_With
);
1037 Project_Directory
:= Immediate_Directory_Of
(Normed_Path_Name
);
1038 Project
:= Default_Project_Node
(Of_Kind
=> N_Project
);
1039 Project_Stack
.Table
(Project_Stack
.Last
).Id
:= Project
;
1040 Set_Directory_Of
(Project
, Project_Directory
);
1041 Set_Path_Name_Of
(Project
, Normed_Path_Name
);
1042 Set_Location_Of
(Project
, Token_Ptr
);
1044 Expect
(Tok_Project
, "PROJECT");
1046 -- Mark location of PROJECT token if present
1048 if Token
= Tok_Project
then
1049 Set_Location_Of
(Project
, Token_Ptr
);
1050 Scan
; -- scan past project
1058 Expect
(Tok_Identifier
, "identifier");
1060 -- If the token is not an identifier, clear the buffer before
1061 -- exiting to indicate that the name of the project is ill-formed.
1063 if Token
/= Tok_Identifier
then
1068 -- Add the identifier name to the buffer
1070 Get_Name_String
(Token_Name
);
1071 Add_To_Buffer
(Name_Buffer
(1 .. Name_Len
));
1073 -- Scan past the identifier
1077 -- If we have a dot, add a dot the the Buffer and look for the next
1080 exit when Token
/= Tok_Dot
;
1081 Add_To_Buffer
(".");
1083 -- Scan past the dot
1088 -- See if this is an extending project
1090 if Token
= Tok_Extends
then
1092 -- Make sure that gnatmake will use mapping files
1094 Create_Mapping_File
:= True;
1096 -- We are extending another project
1100 Scan
; -- scan past EXTENDS
1102 if Token
= Tok_All
then
1103 Extends_All
:= True;
1104 Set_Is_Extending_All
(Project
);
1105 Scan
; -- scan past ALL
1109 -- If the name is well formed, Buffer_Last is > 0
1111 if Buffer_Last
> 0 then
1113 -- The Buffer contains the name of the project
1115 Name_Len
:= Buffer_Last
;
1116 Name_Buffer
(1 .. Name_Len
) := Buffer
(1 .. Buffer_Last
);
1117 Name_Of_Project
:= Name_Find
;
1118 Set_Name_Of
(Project
, Name_Of_Project
);
1120 -- To get expected name of the project file, replace dots by dashes
1122 Name_Len
:= Buffer_Last
;
1123 Name_Buffer
(1 .. Name_Len
) := Buffer
(1 .. Buffer_Last
);
1125 for Index
in 1 .. Name_Len
loop
1126 if Name_Buffer
(Index
) = '.' then
1127 Name_Buffer
(Index
) := '-';
1131 Canonical_Case_File_Name
(Name_Buffer
(1 .. Name_Len
));
1134 Expected_Name
: constant Name_Id
:= Name_Find
;
1137 -- Output a warning if the actual name is not the expected name
1139 if Name_From_Path
/= No_Name
1140 and then Expected_Name
/= Name_From_Path
1142 Error_Msg_Name_1
:= Expected_Name
;
1143 Error_Msg
("?file name does not match unit name, " &
1144 "should be `{" & Project_File_Extension
& "`",
1150 Imported_Projects
: Project_Node_Id
:= Empty_Node
;
1151 From_Ext
: Extension_Origin
:= None
;
1154 -- Extending_All is always propagated
1156 if From_Extended
= Extending_All
or else Extends_All
then
1157 From_Ext
:= Extending_All
;
1159 -- Otherwise, From_Extended is set to Extending_Single if the
1160 -- current project is an extending project.
1163 From_Ext
:= Extending_Simple
;
1166 Post_Parse_Context_Clause
1167 (Context_Clause
=> First_With
,
1168 Imported_Projects
=> Imported_Projects
,
1169 Project_Directory
=> Project_Directory
,
1170 From_Extended
=> From_Ext
,
1171 In_Limited
=> In_Limited
);
1172 Set_First_With_Clause_Of
(Project
, Imported_Projects
);
1176 Name_And_Node
: Tree_Private_Part
.Project_Name_And_Node
:=
1177 Tree_Private_Part
.Projects_Htable
.Get_First
;
1178 Project_Name
: Name_Id
:= Name_And_Node
.Name
;
1181 -- Check if we already have a project with this name
1183 while Project_Name
/= No_Name
1184 and then Project_Name
/= Name_Of_Project
1186 Name_And_Node
:= Tree_Private_Part
.Projects_Htable
.Get_Next
;
1187 Project_Name
:= Name_And_Node
.Name
;
1190 -- Report an error if we already have a project with this name
1192 if Project_Name
/= No_Name
then
1193 Error_Msg_Name_1
:= Project_Name
;
1194 Error_Msg
("duplicate project name {", Location_Of
(Project
));
1195 Error_Msg_Name_1
:= Path_Name_Of
(Name_And_Node
.Node
);
1196 Error_Msg
("\already in {", Location_Of
(Project
));
1199 -- Otherwise, add the name of the project to the hash table, so
1200 -- that we can check that no other subsequent project will have
1203 Tree_Private_Part
.Projects_Htable
.Set
1204 (K
=> Name_Of_Project
,
1205 E
=> (Name
=> Name_Of_Project
,
1207 Extended
=> Extended
));
1214 Expect
(Tok_String_Literal
, "literal string");
1216 if Token
= Tok_String_Literal
then
1217 Set_Extended_Project_Path_Of
(Project
, Token_Name
);
1220 Original_Path_Name
: constant String :=
1221 Get_Name_String
(Token_Name
);
1223 Extended_Project_Path_Name
: constant String :=
1224 Project_Path_Name_Of
1225 (Original_Path_Name
,
1227 (Project_Directory
));
1230 if Extended_Project_Path_Name
= "" then
1232 -- We could not find the project file to extend
1234 Error_Msg_Name_1
:= Token_Name
;
1236 Error_Msg
("unknown project file: {", Token_Ptr
);
1238 -- If we are not in the main project file, display the
1241 if Project_Stack
.Last
> 1 then
1243 Project_Stack
.Table
(Project_Stack
.Last
).Path_Name
;
1244 Error_Msg
("\extended by {", Token_Ptr
);
1246 for Index
in reverse 1 .. Project_Stack
.Last
- 1 loop
1248 Project_Stack
.Table
(Index
).Path_Name
;
1249 Error_Msg
("\imported by {", Token_Ptr
);
1255 From_Ext
: Extension_Origin
:= None
;
1258 if From_Extended
= Extending_All
or else Extends_All
then
1259 From_Ext
:= Extending_All
;
1262 Parse_Single_Project
1263 (Project
=> Extended_Project
,
1264 Extends_All
=> Extends_All
,
1265 Path_Name
=> Extended_Project_Path_Name
,
1267 From_Extended
=> From_Ext
,
1268 In_Limited
=> In_Limited
);
1271 -- A project that extends an extending-all project is also
1272 -- an extending-all project.
1274 if Is_Extending_All
(Extended_Project
) then
1275 Set_Is_Extending_All
(Project
);
1280 Scan
; -- scan past the extended project path
1284 -- Check that a non extending-all project does not import an
1285 -- extending-all project.
1287 if not Is_Extending_All
(Project
) then
1289 With_Clause
: Project_Node_Id
:= First_With_Clause_Of
(Project
);
1290 Imported
: Project_Node_Id
:= Empty_Node
;
1294 while With_Clause
/= Empty_Node
loop
1295 Imported
:= Project_Node_Of
(With_Clause
);
1297 if Is_Extending_All
(With_Clause
) then
1298 Error_Msg_Name_1
:= Name_Of
(Imported
);
1299 Error_Msg
("cannot import extending-all project {",
1301 exit With_Clause_Loop
;
1304 With_Clause
:= Next_With_Clause_Of
(With_Clause
);
1305 end loop With_Clause_Loop
;
1309 -- Check that a project with a name including a dot either imports
1310 -- or extends the project whose name precedes the last dot.
1312 if Name_Of_Project
/= No_Name
then
1313 Get_Name_String
(Name_Of_Project
);
1319 -- Look for the last dot
1321 while Name_Len
> 0 and then Name_Buffer
(Name_Len
) /= '.' loop
1322 Name_Len
:= Name_Len
- 1;
1325 -- If a dot was find, check if the parent project is imported
1328 if Name_Len
> 0 then
1329 Name_Len
:= Name_Len
- 1;
1332 Parent_Name
: constant Name_Id
:= Name_Find
;
1333 Parent_Found
: Boolean := False;
1334 With_Clause
: Project_Node_Id
:= First_With_Clause_Of
(Project
);
1337 -- If there is an extended project, check its name
1339 if Extended_Project
/= Empty_Node
then
1340 Parent_Found
:= Name_Of
(Extended_Project
) = Parent_Name
;
1343 -- If the parent project is not the extended project,
1344 -- check each imported project until we find the parent project.
1346 while not Parent_Found
and then With_Clause
/= Empty_Node
loop
1347 Parent_Found
:= Name_Of
(Project_Node_Of
(With_Clause
))
1349 With_Clause
:= Next_With_Clause_Of
(With_Clause
);
1352 -- If the parent project was not found, report an error
1354 if not Parent_Found
then
1355 Error_Msg_Name_1
:= Name_Of_Project
;
1356 Error_Msg_Name_2
:= Parent_Name
;
1357 Error_Msg
("project { does not import or extend project {",
1358 Location_Of
(Project
));
1363 Expect
(Tok_Is
, "IS");
1364 Set_End_Of_Line
(Project
);
1365 Set_Previous_Line_Node
(Project
);
1366 Set_Next_End_Node
(Project
);
1369 Project_Declaration
: Project_Node_Id
:= Empty_Node
;
1372 -- No need to Scan past "is", Prj.Dect.Parse will do it.
1375 (Declarations
=> Project_Declaration
,
1376 Current_Project
=> Project
,
1377 Extends
=> Extended_Project
);
1378 Set_Project_Declaration_Of
(Project
, Project_Declaration
);
1380 if Extended_Project
/= Empty_Node
then
1381 Set_Extending_Project_Of
1382 (Project_Declaration_Of
(Extended_Project
), To
=> Project
);
1386 Expect
(Tok_End
, "END");
1387 Remove_Next_End_Node
;
1389 -- Skip "end" if present
1391 if Token
= Tok_End
then
1399 -- Store the name following "end" in the Buffer. The name may be made of
1400 -- several simple names.
1403 Expect
(Tok_Identifier
, "identifier");
1405 -- If we don't have an identifier, clear the buffer before exiting to
1406 -- avoid checking the name.
1408 if Token
/= Tok_Identifier
then
1413 -- Add the identifier to the Buffer
1414 Get_Name_String
(Token_Name
);
1415 Add_To_Buffer
(Name_Buffer
(1 .. Name_Len
));
1417 -- Scan past the identifier
1420 exit when Token
/= Tok_Dot
;
1421 Add_To_Buffer
(".");
1425 -- If we have a valid name, check if it is the name of the project
1427 if Name_Of_Project
/= No_Name
and then Buffer_Last
> 0 then
1428 if To_Lower
(Buffer
(1 .. Buffer_Last
)) /=
1429 Get_Name_String
(Name_Of
(Project
))
1431 -- Invalid name: report an error
1433 Error_Msg
("Expected """ &
1434 Get_Name_String
(Name_Of
(Project
)) & """",
1439 Expect
(Tok_Semicolon
, "`;`");
1441 -- Check that there is no more text following the end of the project
1444 if Token
= Tok_Semicolon
then
1445 Set_Previous_End_Node
(Project
);
1448 if Token
/= Tok_EOF
then
1450 ("Unexpected text following end of project", Token_Ptr
);
1454 -- Restore the scan state, in case we are not the main project
1456 Restore_Project_Scan_State
(Project_Scan_State
);
1458 -- And remove the project from the project stack
1460 Project_Stack
.Decrement_Last
;
1462 -- Indicate if there are unkept comments
1464 Tree
.Set_Project_File_Includes_Unkept_Comments
1465 (Node
=> Project
, To
=> Tree
.There_Are_Unkept_Comments
);
1467 -- And restore the comment state that was saved
1469 Tree
.Restore
(Project_Comment_State
);
1470 end Parse_Single_Project
;
1472 -----------------------
1473 -- Project_Name_From --
1474 -----------------------
1476 function Project_Name_From
(Path_Name
: String) return Name_Id
is
1477 Canonical
: String (1 .. Path_Name
'Length) := Path_Name
;
1478 First
: Natural := Canonical
'Last;
1479 Last
: Natural := First
;
1483 if Current_Verbosity
= High
then
1484 Write_Str
("Project_Name_From (""");
1485 Write_Str
(Canonical
);
1489 -- If the path name is empty, return No_Name to indicate failure
1495 Canonical_Case_File_Name
(Canonical
);
1497 -- Look for the last dot in the path name
1501 Canonical
(First
) /= '.'
1506 -- If we have a dot, check that it is followed by the correct extension
1508 if First
> 0 and then Canonical
(First
) = '.' then
1509 if Canonical
(First
.. Last
) = Project_File_Extension
1512 -- Look for the last directory separator, if any
1518 and then Canonical
(First
) /= '/'
1519 and then Canonical
(First
) /= Dir_Sep
1525 -- Not the correct extension, return No_Name to indicate failure
1530 -- If no dot in the path name, return No_Name to indicate failure
1538 -- If the extension is the file name, return No_Name to indicate failure
1540 if First
> Last
then
1544 -- Put the name in lower case into Name_Buffer
1546 Name_Len
:= Last
- First
+ 1;
1547 Name_Buffer
(1 .. Name_Len
) := To_Lower
(Canonical
(First
.. Last
));
1551 -- Check if it is a well formed project name. Return No_Name if it is
1555 if not Is_Letter
(Name_Buffer
(Index
)) then
1562 exit when Index
>= Name_Len
;
1564 if Name_Buffer
(Index
) = '_' then
1565 if Name_Buffer
(Index
+ 1) = '_' then
1570 exit when Name_Buffer
(Index
) = '-';
1572 if Name_Buffer
(Index
) /= '_'
1573 and then not Is_Alphanumeric
(Name_Buffer
(Index
))
1581 if Index
>= Name_Len
then
1582 if Is_Alphanumeric
(Name_Buffer
(Name_Len
)) then
1584 -- All checks have succeeded. Return name in Name_Buffer
1592 elsif Name_Buffer
(Index
) = '-' then
1596 end Project_Name_From
;
1598 --------------------------
1599 -- Project_Path_Name_Of --
1600 --------------------------
1602 function Project_Path_Name_Of
1603 (Project_File_Name
: String;
1604 Directory
: String) return String
1606 Result
: String_Access
;
1609 if Current_Verbosity
= High
then
1610 Write_Str
("Project_Path_Name_Of (""");
1611 Write_Str
(Project_File_Name
);
1612 Write_Str
(""", """);
1613 Write_Str
(Directory
);
1614 Write_Line
(""");");
1617 if not Is_Absolute_Path
(Project_File_Name
) then
1618 -- First we try <directory>/<file_name>.<extension>
1620 if Current_Verbosity
= High
then
1621 Write_Str
(" Trying ");
1622 Write_Str
(Directory
);
1623 Write_Char
(Directory_Separator
);
1624 Write_Str
(Project_File_Name
);
1625 Write_Line
(Project_File_Extension
);
1630 (File_Name
=> Directory
& Directory_Separator
&
1631 Project_File_Name
& Project_File_Extension
,
1632 Path
=> Project_Path
.all);
1634 -- Then we try <directory>/<file_name>
1636 if Result
= null then
1637 if Current_Verbosity
= High
then
1638 Write_Str
(" Trying ");
1639 Write_Str
(Directory
);
1640 Write_Char
(Directory_Separator
);
1641 Write_Line
(Project_File_Name
);
1646 (File_Name
=> Directory
& Directory_Separator
&
1648 Path
=> Project_Path
.all);
1652 if Result
= null then
1654 -- Then we try <file_name>.<extension>
1656 if Current_Verbosity
= High
then
1657 Write_Str
(" Trying ");
1658 Write_Str
(Project_File_Name
);
1659 Write_Line
(Project_File_Extension
);
1664 (File_Name
=> Project_File_Name
& Project_File_Extension
,
1665 Path
=> Project_Path
.all);
1668 if Result
= null then
1670 -- Then we try <file_name>
1672 if Current_Verbosity
= High
then
1673 Write_Str
(" Trying ");
1674 Write_Line
(Project_File_Name
);
1679 (File_Name
=> Project_File_Name
,
1680 Path
=> Project_Path
.all);
1683 -- If we cannot find the project file, we return an empty string
1685 if Result
= null then
1690 Final_Result
: constant String :=
1691 GNAT
.OS_Lib
.Normalize_Pathname
1693 Resolve_Links
=> False,
1694 Case_Sensitive
=> True);
1697 return Final_Result
;
1700 end Project_Path_Name_Of
;
1703 -- Initialize Project_Path during package elaboration
1705 if Prj_Path
.all = "" then
1706 Project_Path
:= new String'(".");
1708 Project_Path := new String'("." & Path_Separator
& Prj_Path
.all);