1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2001-2002 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 Ada.Characters.Handling; use Ada.Characters.Handling;
28 with Ada.Exceptions; use Ada.Exceptions;
29 with Errout; use Errout;
30 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
31 with GNAT.OS_Lib; use GNAT.OS_Lib;
32 with Namet; use Namet;
33 with Osint; use Osint;
34 with Output; use Output;
35 with Prj.Com; use Prj.Com;
37 with Scans; use Scans;
39 with Sinfo; use Sinfo;
40 with Sinput; use Sinput;
41 with Sinput.P; use Sinput.P;
42 with Stringt; use Stringt;
44 with Types; use Types;
46 pragma Elaborate_All (GNAT.OS_Lib);
48 package body Prj.Part is
50 Dir_Sep : Character renames GNAT.OS_Lib.Directory_Separator;
52 Project_Path : String_Access;
53 -- The project path; initialized during package elaboration.
55 Ada_Project_Path : constant String := "ADA_PROJECT_PATH";
56 Prj_Path : constant String_Access := Getenv (Ada_Project_Path);
58 ------------------------------------
59 -- Local Packages and Subprograms --
60 ------------------------------------
62 package Project_Stack is new Table.Table
63 (Table_Component_Type => Name_Id,
64 Table_Index_Type => Nat,
67 Table_Increment => 10,
68 Table_Name => "Prj.Part.Project_Stack");
69 -- This table is used to detect circular dependencies
70 -- for imported and modified projects.
72 procedure Parse_Context_Clause
73 (Context_Clause : out Project_Node_Id;
74 Project_Directory : Name_Id);
75 -- Parse the context clause of a project
76 -- Does nothing if there is b\no context clause (if the current
77 -- token is not "with").
79 procedure Parse_Single_Project
80 (Project : out Project_Node_Id;
83 -- Parse a project file.
84 -- Recursive procedure: it calls itself for imported and
87 function Project_Path_Name_Of
88 (Project_File_Name : String;
91 -- Returns the path name of a project file.
92 -- Returns an empty string if project file cannot be found.
94 function Immediate_Directory_Of (Path_Name : Name_Id) return Name_Id;
95 -- Get the directory of the file with the specified path name.
96 -- This includes the directory separator as the last character.
97 -- Returns "./" if Path_Name contains no directory separator.
99 function Simple_File_Name_Of (Path_Name : Name_Id) return Name_Id;
100 -- Returns the name of a file with the specified path name
101 -- with no directory information.
103 function Project_Name_From (Path_Name : String) return Name_Id;
104 -- Returns the name of the project that corresponds to its path name.
105 -- Returns No_Name if the path name is invalid, because the corresponding
106 -- project name does not have the syntax of an ada identifier.
108 ----------------------------
109 -- Immediate_Directory_Of --
110 ----------------------------
112 function Immediate_Directory_Of (Path_Name : Name_Id) return Name_Id is
114 Get_Name_String (Path_Name);
116 for Index in reverse 1 .. Name_Len loop
117 if Name_Buffer (Index) = '/'
118 or else Name_Buffer (Index) = Dir_Sep
120 -- Remove from name all characters after the last
121 -- directory separator.
128 -- There is no directory separator in name. Return "./" or ".\"
131 Name_Buffer (1) := '.';
132 Name_Buffer (2) := Dir_Sep;
134 end Immediate_Directory_Of;
141 (Project : out Project_Node_Id;
142 Project_File_Name : String;
143 Always_Errout_Finalize : Boolean)
145 Current_Directory : constant String := Get_Current_Dir;
148 Project := Empty_Node;
150 if Current_Verbosity >= Medium then
151 Write_Str ("ADA_PROJECT_PATH=""");
152 Write_Str (Project_Path.all);
157 Path_Name : constant String :=
158 Project_Path_Name_Of (Project_File_Name,
159 Directory => Current_Directory);
164 -- Parse the main project file
166 if Path_Name = "" then
167 Fail ("project file """ & Project_File_Name & """ not found");
172 Path_Name => Path_Name,
175 -- If there were any kind of error during the parsing, serious
176 -- or not, then the parsing fails.
178 if Errout.Total_Errors_Detected > 0 then
179 Project := Empty_Node;
182 if Project = Empty_Node or else Always_Errout_Finalize then
192 Write_Line (Exception_Information (X));
193 Write_Str ("Exception ");
194 Write_Str (Exception_Name (X));
195 Write_Line (" raised, while processing project file");
196 Project := Empty_Node;
199 --------------------------
200 -- Parse_Context_Clause --
201 --------------------------
203 procedure Parse_Context_Clause
204 (Context_Clause : out Project_Node_Id;
205 Project_Directory : Name_Id)
207 Project_Directory_Path : constant String :=
208 Get_Name_String (Project_Directory);
209 Current_With_Clause : Project_Node_Id := Empty_Node;
210 Next_With_Clause : Project_Node_Id := Empty_Node;
213 -- Assume no context clause
215 Context_Clause := Empty_Node;
218 -- If Token is not WITH, there is no context clause,
219 -- or we have exhausted the with clauses.
221 while Token = Tok_With loop
224 Scan; -- scan past WITH or ","
226 Expect (Tok_String_Literal, "literal string");
228 if Token /= Tok_String_Literal then
232 String_To_Name_Buffer (Strval (Token_Node));
235 Original_Path : constant String :=
236 Name_Buffer (1 .. Name_Len);
238 Imported_Path_Name : constant String :=
241 Project_Directory_Path);
243 Withed_Project : Project_Node_Id := Empty_Node;
246 if Imported_Path_Name = "" then
248 -- The project file cannot be found
250 Name_Len := Original_Path'Length;
251 Name_Buffer (1 .. Name_Len) := Original_Path;
252 Error_Msg_Name_1 := Name_Find;
254 Error_Msg ("unknown project file: {", Token_Ptr);
256 -- If this is not imported by the main project file,
257 -- display the import path.
259 if Project_Stack.Last > 1 then
260 for Index in reverse 1 .. Project_Stack.Last loop
261 Error_Msg_Name_1 := Project_Stack.Table (Index);
262 Error_Msg ("\imported by {", Token_Ptr);
269 if Current_With_Clause = Empty_Node then
271 -- First with clause of the context clause
273 Current_With_Clause := Default_Project_Node
274 (Of_Kind => N_With_Clause);
275 Context_Clause := Current_With_Clause;
278 Next_With_Clause := Default_Project_Node
279 (Of_Kind => N_With_Clause);
280 Set_Next_With_Clause_Of
281 (Current_With_Clause, Next_With_Clause);
282 Current_With_Clause := Next_With_Clause;
286 (Current_With_Clause, Strval (Token_Node));
287 Set_Location_Of (Current_With_Clause, Token_Ptr);
288 String_To_Name_Buffer
289 (String_Value_Of (Current_With_Clause));
291 -- Parse the imported project
294 (Project => Withed_Project,
295 Path_Name => Imported_Path_Name,
298 if Withed_Project /= Empty_Node then
300 -- If parsing was successful, record project name
301 -- and path name in with clause
303 Set_Project_Node_Of (Current_With_Clause, Withed_Project);
304 Set_Name_Of (Current_With_Clause,
305 Name_Of (Withed_Project));
306 Name_Len := Imported_Path_Name'Length;
307 Name_Buffer (1 .. Name_Len) := Imported_Path_Name;
308 Set_Path_Name_Of (Current_With_Clause, Name_Find);
314 if Token = Tok_Semicolon then
316 -- End of (possibly multiple) with clause;
318 Scan; -- scan past the semicolon.
321 elsif Token /= Tok_Comma then
322 Error_Msg ("expected comma or semi colon", Token_Ptr);
328 end Parse_Context_Clause;
330 --------------------------
331 -- Parse_Single_Project --
332 --------------------------
334 procedure Parse_Single_Project
335 (Project : out Project_Node_Id;
339 Canonical_Path_Name : Name_Id;
340 Project_Directory : Name_Id;
341 Project_Scan_State : Saved_Project_Scan_State;
342 Source_Index : Source_File_Index;
344 Modified_Project : Project_Node_Id := Empty_Node;
346 A_Project_Name_And_Node : Tree_Private_Part.Project_Name_And_Node :=
347 Tree_Private_Part.Projects_Htable.Get_First;
349 Name_From_Path : constant Name_Id := Project_Name_From (Path_Name);
351 use Tree_Private_Part;
354 Name_Len := Path_Name'Length;
355 Name_Buffer (1 .. Name_Len) := Path_Name;
356 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
357 Canonical_Path_Name := Name_Find;
359 -- Check for a circular dependency
361 for Index in 1 .. Project_Stack.Last loop
362 if Canonical_Path_Name = Project_Stack.Table (Index) then
363 Error_Msg ("circular dependency detected", Token_Ptr);
364 Error_Msg_Name_1 := Canonical_Path_Name;
365 Error_Msg ("\ { is imported by", Token_Ptr);
367 for Current in reverse 1 .. Project_Stack.Last loop
368 Error_Msg_Name_1 := Project_Stack.Table (Current);
370 if Error_Msg_Name_1 /= Canonical_Path_Name then
372 ("\ { which itself is imported by", Token_Ptr);
375 Error_Msg ("\ {", Token_Ptr);
380 Project := Empty_Node;
385 Project_Stack.Increment_Last;
386 Project_Stack.Table (Project_Stack.Last) := Canonical_Path_Name;
388 -- Check if the project file has already been parsed.
391 A_Project_Name_And_Node /= Tree_Private_Part.No_Project_Name_And_Node
394 Path_Name_Of (A_Project_Name_And_Node.Node) = Canonical_Path_Name
398 if A_Project_Name_And_Node.Modified then
400 ("cannot modify the same project file several times",
405 ("cannot modify an imported project file",
409 elsif A_Project_Name_And_Node.Modified then
411 ("cannot imported a modified project file",
415 Project := A_Project_Name_And_Node.Node;
416 Project_Stack.Decrement_Last;
420 A_Project_Name_And_Node := Tree_Private_Part.Projects_Htable.Get_Next;
423 -- We never encountered this project file
424 -- Save the scan state, load the project file and start to scan it.
426 Save_Project_Scan_State (Project_Scan_State);
427 Source_Index := Load_Project_File (Path_Name);
429 -- if we cannot find it, we stop
431 if Source_Index = No_Source_File then
432 Project := Empty_Node;
433 Project_Stack.Decrement_Last;
437 Initialize_Scanner (Types.No_Unit, Source_Index);
439 if Name_From_Path = No_Name then
441 -- The project file name is not correct (no or bad extension,
442 -- or not following Ada identifier's syntax).
444 Error_Msg_Name_1 := Canonical_Path_Name;
445 Error_Msg ("?{ is not a valid path name for a project file",
449 if Current_Verbosity >= Medium then
450 Write_Str ("Parsing """);
451 Write_Str (Path_Name);
456 Project_Directory := Immediate_Directory_Of (Canonical_Path_Name);
457 Project := Default_Project_Node (Of_Kind => N_Project);
458 Set_Directory_Of (Project, Project_Directory);
459 Set_Name_Of (Project, Simple_File_Name_Of (Canonical_Path_Name));
460 Set_Path_Name_Of (Project, Canonical_Path_Name);
461 Set_Location_Of (Project, Token_Ptr);
463 -- Is there any imported project?
466 First_With_Clause : Project_Node_Id := Empty_Node;
469 Parse_Context_Clause (Context_Clause => First_With_Clause,
470 Project_Directory => Project_Directory);
471 Set_First_With_Clause_Of (Project, First_With_Clause);
474 Expect (Tok_Project, "project");
476 -- Mark location of PROJECT token if present
478 if Token = Tok_Project then
479 Set_Location_Of (Project, Token_Ptr);
480 Scan; -- scan past project
483 Expect (Tok_Identifier, "identifier");
485 if Token = Tok_Identifier then
486 Set_Name_Of (Project, Token_Name);
488 Get_Name_String (Token_Name);
489 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
492 Expected_Name : constant Name_Id := Name_Find;
495 if Name_From_Path /= No_Name
496 and then Expected_Name /= Name_From_Path
498 -- The project name is not the one that was expected from
499 -- the file name. Report a warning.
501 Error_Msg_Name_1 := Expected_Name;
502 Error_Msg ("?file name does not match unit name, " &
503 "should be `{" & Project_File_Extension & "`",
509 Project_Name : Name_Id :=
510 Tree_Private_Part.Projects_Htable.Get_First.Name;
513 -- Check if we already have a project with this name
515 while Project_Name /= No_Name
516 and then Project_Name /= Token_Name
518 Project_Name := Tree_Private_Part.Projects_Htable.Get_Next.Name;
521 if Project_Name /= No_Name then
522 Error_Msg ("duplicate project name", Token_Ptr);
525 Tree_Private_Part.Projects_Htable.Set
527 E => (Name => Token_Name,
529 Modified => Modified));
533 Scan; -- scan past the project name
536 if Token = Tok_Extends then
538 -- We are extending another project
540 Scan; -- scan past EXTENDS
541 Expect (Tok_String_Literal, "literal string");
543 if Token = Tok_String_Literal then
544 Set_Modified_Project_Path_Of (Project, Strval (Token_Node));
545 String_To_Name_Buffer (Modified_Project_Path_Of (Project));
548 Original_Path_Name : constant String :=
549 Name_Buffer (1 .. Name_Len);
551 Modified_Project_Path_Name : constant String :=
555 (Project_Directory));
558 if Modified_Project_Path_Name = "" then
560 -- We could not find the project file to modify
562 Name_Len := Original_Path_Name'Length;
563 Name_Buffer (1 .. Name_Len) := Original_Path_Name;
564 Error_Msg_Name_1 := Name_Find;
566 Error_Msg ("unknown project file: {", Token_Ptr);
568 -- If we are not in the main project file, display the
571 if Project_Stack.Last > 1 then
573 Project_Stack.Table (Project_Stack.Last);
574 Error_Msg ("\extended by {", Token_Ptr);
576 for Index in reverse 1 .. Project_Stack.Last - 1 loop
577 Error_Msg_Name_1 := Project_Stack.Table (Index);
578 Error_Msg ("\imported by {", Token_Ptr);
584 (Project => Modified_Project,
585 Path_Name => Modified_Project_Path_Name,
590 Scan; -- scan past the modified project path
594 Expect (Tok_Is, "is");
597 Project_Declaration : Project_Node_Id := Empty_Node;
600 -- No need to Scan past IS, Prj.Dect.Parse will do it.
603 (Declarations => Project_Declaration,
604 Current_Project => Project,
605 Extends => Modified_Project);
606 Set_Project_Declaration_Of (Project, Project_Declaration);
609 Expect (Tok_End, "end");
611 -- Skip END if present
613 if Token = Tok_End then
617 Expect (Tok_Identifier, "identifier");
619 if Token = Tok_Identifier then
621 -- We check if this is the project name
623 if To_Lower (Get_Name_String (Token_Name)) /=
624 Get_Name_String (Name_Of (Project))
626 Error_Msg ("Expected """ &
627 Get_Name_String (Name_Of (Project)) & """",
632 if Token /= Tok_Semicolon then
636 Expect (Tok_Semicolon, ";");
638 -- Restore the scan state, in case we are not the main project
640 Restore_Project_Scan_State (Project_Scan_State);
642 Project_Stack.Decrement_Last;
643 end Parse_Single_Project;
645 -----------------------
646 -- Project_Name_From --
647 -----------------------
649 function Project_Name_From (Path_Name : String) return Name_Id is
650 Canonical : String (1 .. Path_Name'Length) := Path_Name;
651 First : Natural := Canonical'Last;
652 Last : Positive := First;
659 Canonical_Case_File_Name (Canonical);
663 Canonical (First) /= '.'
668 if Canonical (First) = '.' then
669 if Canonical (First .. Last) = Project_File_Extension
676 and then Canonical (First) /= '/'
677 and then Canonical (First) /= Dir_Sep
690 if Canonical (First) = '/'
691 or else Canonical (First) = Dir_Sep
696 Name_Len := Last - First + 1;
697 Name_Buffer (1 .. Name_Len) := To_Lower (Canonical (First .. Last));
699 if not Is_Letter (Name_Buffer (1)) then
703 for Index in 2 .. Name_Len - 1 loop
704 if Name_Buffer (Index) = '_' then
705 if Name_Buffer (Index + 1) = '_' then
709 elsif not Is_Alphanumeric (Name_Buffer (Index)) then
715 if not Is_Alphanumeric (Name_Buffer (Name_Len)) then
723 end Project_Name_From;
725 --------------------------
726 -- Project_Path_Name_Of --
727 --------------------------
729 function Project_Path_Name_Of
730 (Project_File_Name : String;
734 Result : String_Access;
737 -- First we try <file_name>.<extension>
739 if Current_Verbosity = High then
740 Write_Str ("Project_Path_Name_Of (""");
741 Write_Str (Project_File_Name);
742 Write_Str (""", """);
743 Write_Str (Directory);
745 Write_Str (" Trying ");
746 Write_Str (Project_File_Name);
747 Write_Line (Project_File_Extension);
752 (File_Name => Project_File_Name & Project_File_Extension,
753 Path => Project_Path.all);
755 -- Then we try <file_name>
757 if Result = null then
758 if Current_Verbosity = High then
759 Write_Str (" Trying ");
760 Write_Line (Project_File_Name);
765 (File_Name => Project_File_Name,
766 Path => Project_Path.all);
768 -- The we try <directory>/<file_name>.<extension>
770 if Result = null then
771 if Current_Verbosity = High then
772 Write_Str (" Trying ");
773 Write_Str (Directory);
774 Write_Str (Project_File_Name);
775 Write_Line (Project_File_Extension);
780 (File_Name => Directory & Project_File_Name &
781 Project_File_Extension,
782 Path => Project_Path.all);
784 -- Then we try <directory>/<file_name>
786 if Result = null then
787 if Current_Verbosity = High then
788 Write_Str (" Trying ");
789 Write_Str (Directory);
790 Write_Line (Project_File_Name);
795 (File_Name => Directory & Project_File_Name,
796 Path => Project_Path.all);
801 -- If we cannot find the project file, we return an empty string
803 if Result = null then
808 Final_Result : String
809 := GNAT.OS_Lib.Normalize_Pathname (Result.all);
812 Canonical_Case_File_Name (Final_Result);
818 end Project_Path_Name_Of;
820 -------------------------
821 -- Simple_File_Name_Of --
822 -------------------------
824 function Simple_File_Name_Of (Path_Name : Name_Id) return Name_Id is
826 Get_Name_String (Path_Name);
828 for Index in reverse 1 .. Name_Len loop
829 if Name_Buffer (Index) = '/'
830 or else Name_Buffer (Index) = Dir_Sep
832 exit when Index = Name_Len;
833 Name_Buffer (1 .. Name_Len - Index) :=
834 Name_Buffer (Index + 1 .. Name_Len);
835 Name_Len := Name_Len - Index;
842 end Simple_File_Name_Of;
845 if Prj_Path.all = "" then
846 Project_Path := new String'(".");
849 Project_Path := new String'("." & Path_Separator & Prj_Path.all);