with Snames;
with Table;
-with Ada.Characters.Handling; use Ada.Characters.Handling;
-with Ada.Exceptions; use Ada.Exceptions;
+with Ada.Characters.Handling; use Ada.Characters.Handling;
+with Ada.Exceptions; use Ada.Exceptions;
-with GNAT.Directory_Operations; use GNAT.Directory_Operations;
+with GNAT.Directory_Operations; use GNAT.Directory_Operations;
-with System.HTable; use System.HTable;
+with System.HTable; use System.HTable;
package body Prj.Part is
Buffer : String_Access;
Buffer_Last : Natural := 0;
- Dir_Sep : Character renames GNAT.OS_Lib.Directory_Separator;
-
- type Extension_Origin is (None, Extending_Simple, Extending_All);
- -- Type of parameter From_Extended for procedures Parse_Single_Project and
- -- Post_Parse_Context_Clause. Extending_All means that we are parsing the
- -- tree rooted at an extending all project.
+ Dir_Sep : Character renames GNAT.OS_Lib.Directory_Separator;
------------------------------------
-- Local Packages and Subprograms --
No_With : constant With_Id := 0;
type With_Record is record
- Path : File_Name_Type;
+ Path : Path_Name_Type;
Location : Source_Ptr;
Limited_With : Boolean;
Node : Project_Node_Id;
Canonical_Path_Name : Path_Name_Type;
Id : Project_Node_Id;
end record;
- -- Needs a comment ???
package Project_Stack is new Table.Table
(Table_Component_Type => Names_And_Id,
Project_Directory : Path_Name_Type;
From_Extended : Extension_Origin;
In_Limited : Boolean;
- Packages_To_Check : String_List_Access);
+ Packages_To_Check : String_List_Access;
+ Depth : Natural);
-- Parse the imported projects that have been stored in table Withs,
-- if any. From_Extended is used for the call to Parse_Single_Project
-- below. When In_Limited is True, the importing path includes at least
-- one "limited with".
- procedure Parse_Single_Project
- (In_Tree : Project_Node_Tree_Ref;
- Project : out Project_Node_Id;
- Extends_All : out Boolean;
- Path_Name : String;
- Extended : Boolean;
- From_Extended : Extension_Origin;
- In_Limited : Boolean;
- Packages_To_Check : String_List_Access);
- -- Parse a project file.
- -- Recursive procedure: it calls itself for imported and extended
- -- projects. When From_Extended is not None, if the project has already
- -- been parsed and is an extended project A, return the ultimate
- -- (not extended) project that extends A. When In_Limited is True,
- -- the importing path includes at least one "limited with".
-
function Project_Path_Name_Of
(Project_File_Name : String;
Directory : String) return String;
-- This includes the directory separator as the last character.
-- Returns "./" if Path_Name contains no directory separator.
- function Project_Name_From (Path_Name : String) return File_Name_Type;
+ function Project_Name_From (Path_Name : String) return Name_Id;
-- Returns the name of the project that corresponds to its path name.
-- Returns No_Name if the path name is invalid, because the corresponding
-- project name does not have the syntax of an ada identifier.
----------------------------
function Immediate_Directory_Of
- (Path_Name : Path_Name_Type) return Path_Name_Type
+ (Path_Name : Path_Name_Type)
+ return Path_Name_Type
is
begin
Get_Name_String (Path_Name);
Project := Empty_Node;
if Current_Verbosity >= Medium then
- Write_Str ("ADA_PROJECT_PATH=""");
+ Write_Str ("GPR_PROJECT_PATH=""");
Write_Str (Project_Path);
Write_Line ("""");
end if;
Extended => False,
From_Extended => None,
In_Limited => False,
- Packages_To_Check => Packages_To_Check);
+ Packages_To_Check => Packages_To_Check,
+ Depth => 0);
-- If Project is an extending-all project, create the eventual
-- virtual extending projects and check that there are no illegally
Default_Project_Node (Of_Kind => N_With_Clause, In_Tree => In_Tree);
Limited_With := Token = Tok_Limited;
+ if In_Configuration then
+ Error_Msg
+ ("configuration project cannot import " &
+ "other configuration projects",
+ Token_Ptr);
+ end if;
+
if Limited_With then
Scan (In_Tree); -- scan past LIMITED
Expect (Tok_With, "WITH");
-- Store path and location in table Withs
Current_With :=
- (Path => File_Name_Type (Token_Name),
+ (Path => Path_Name_Type (Token_Name),
Location => Token_Ptr,
Limited_With => Limited_With,
Node => Current_With_Node,
Project_Directory : Path_Name_Type;
From_Extended : Extension_Origin;
In_Limited : Boolean;
- Packages_To_Check : String_List_Access)
+ Packages_To_Check : String_List_Access;
+ Depth : Natural)
is
- Current_With_Clause : With_Id;
+ Current_With_Clause : With_Id := Context_Clause;
Current_Project : Project_Node_Id := Empty_Node;
Previous_Project : Project_Node_Id := Empty_Node;
begin
Imported_Projects := Empty_Node;
- Current_With_Clause := Context_Clause;
while Current_With_Clause /= No_With loop
Current_With := Withs.Table (Current_With_Clause);
Current_With_Clause := Current_With.Next;
-- The project file cannot be found
- Error_Msg_File_1 := Current_With.Path;
+ Error_Msg_File_1 := File_Name_Type (Current_With.Path);
+
Error_Msg ("unknown project file: {", Current_With.Location);
-- If this is not imported by the main project file,
Extended => False,
From_Extended => From_Extended,
In_Limited => Limited_With,
- Packages_To_Check => Packages_To_Check);
+ Packages_To_Check => Packages_To_Check,
+ Depth => Depth);
else
Extends_All := Is_Extending_All (Withed_Project, In_Tree);
Extended : Boolean;
From_Extended : Extension_Origin;
In_Limited : Boolean;
- Packages_To_Check : String_List_Access)
+ Packages_To_Check : String_List_Access;
+ Depth : Natural)
is
Normed_Path_Name : Path_Name_Type;
Canonical_Path_Name : Path_Name_Type;
Extending : Boolean := False;
- Extended_Project : Project_Node_Id := Empty_Node;
+ Extended_Project : Project_Node_Id := Empty_Node;
A_Project_Name_And_Node : Tree_Private_Part.Project_Name_And_Node :=
Tree_Private_Part.Projects_Htable.Get_First
(In_Tree.Projects_HT);
- Name_From_Path : constant File_Name_Type :=
- Project_Name_From (Path_Name);
+ Name_From_Path : constant Name_Id := Project_Name_From (Path_Name);
Name_Of_Project : Name_Id := No_Name;
Project_Stack.Table (Index).Canonical_Path_Name
then
Error_Msg ("circular dependency detected", Token_Ptr);
- Error_Msg_File_1 := File_Name_Type (Normed_Path_Name);
- Error_Msg ("\\ { is imported by", Token_Ptr);
+ Error_Msg_Name_1 := Name_Id (Normed_Path_Name);
+ Error_Msg ("\ %% is imported by", Token_Ptr);
for Current in reverse 1 .. Project_Stack.Last loop
- Error_Msg_File_1 :=
- File_Name_Type (Project_Stack.Table (Current).Path_Name);
+ Error_Msg_Name_1 :=
+ Name_Id (Project_Stack.Table (Current).Path_Name);
if Project_Stack.Table (Current).Canonical_Path_Name /=
Canonical_Path_Name
then
Error_Msg
- ("\\ { which itself is imported by", Token_Ptr);
+ ("\ %% which itself is imported by", Token_Ptr);
else
- Error_Msg ("\\ {", Token_Ptr);
+ Error_Msg ("\ %%", Token_Ptr);
exit;
end if;
end loop;
Tree.Reset_State;
Scan (In_Tree);
- if Name_From_Path = No_File then
+ if (not In_Configuration) and then (Name_From_Path = No_Name) then
-- The project file name is not correct (no or bad extension,
-- or not following Ada identifier's syntax).
Error_Msg_File_1 := File_Name_Type (Canonical_Path_Name);
- Error_Msg ("?{ is not a valid path name for a project file",
- Token_Ptr);
+
+ if In_Configuration then
+ Error_Msg ("{ is not a valid path name for a configuration " &
+ "project file",
+ Token_Ptr);
+
+ else
+ Error_Msg ("?{ is not a valid path name for a project file",
+ Token_Ptr);
+ end if;
end if;
if Current_Verbosity >= Medium then
Scan (In_Tree);
- -- If we have a dot, add a dot the the Buffer and look for the next
+ -- If we have a dot, add a dot to the Buffer and look for the next
-- identifier.
exit when Token /= Tok_Dot;
if Token = Tok_Extends then
+ if In_Configuration then
+ Error_Msg
+ ("extending configuration project not allowed", Token_Ptr);
+ end if;
+
-- Make sure that gnatmake will use mapping files
Create_Mapping_File := True;
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
declare
- Expected_Name : constant File_Name_Type := Name_Find;
+ Expected_Name : constant Name_Id := Name_Find;
+ Extension : String_Access;
begin
-- Output a warning if the actual name is not the expected name
- if Name_From_Path /= No_File
+ if (not In_Configuration)
+ and then (Name_From_Path /= No_Name)
and then Expected_Name /= Name_From_Path
then
- Error_Msg_File_1 := Expected_Name;
- Error_Msg ("?file name does not match unit name, " &
- "should be `{" & Project_File_Extension & "`",
+ Error_Msg_Name_1 := Expected_Name;
+
+ if In_Configuration then
+ Extension := new String'(Config_Project_File_Extension);
+
+ else
+ Extension := new String'(Project_File_Extension);
+ end if;
+
+ Error_Msg ("?file name does not match project name, " &
+ "should be `%%" & Extension.all & "`",
Token_Ptr);
end if;
end;
Project_Directory => Project_Directory,
From_Extended => From_Ext,
In_Limited => In_Limited,
- Packages_To_Check => Packages_To_Check);
+ Packages_To_Check => Packages_To_Check,
+ Depth => Depth + 1);
Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects);
end;
declare
Name_And_Node : Tree_Private_Part.Project_Name_And_Node :=
- Tree_Private_Part.Projects_Htable.Get_First
- (In_Tree.Projects_HT);
-
+ Tree_Private_Part.Projects_Htable.Get_First
+ (In_Tree.Projects_HT);
Project_Name : Name_Id := Name_And_Node.Name;
begin
Error_Msg_Name_1 := Project_Name;
Error_Msg
("duplicate project name %%", Location_Of (Project, In_Tree));
- Error_Msg_File_1 :=
- File_Name_Type (Path_Name_Of (Name_And_Node.Node, In_Tree));
+ Error_Msg_Name_1 :=
+ Name_Id (Path_Name_Of (Name_And_Node.Node, In_Tree));
Error_Msg
- ("\already in {", Location_Of (Project, In_Tree));
+ ("\already in %%", Location_Of (Project, In_Tree));
else
-- Otherwise, add the name of the project to the hash table, so
if Token = Tok_String_Literal then
Set_Extended_Project_Path_Of
- (Project, In_Tree, Path_Name_Type (Token_Name));
+ (Project,
+ In_Tree,
+ Path_Name_Type (Token_Name));
declare
Original_Path_Name : constant String :=
-- We could not find the project file to extend
- Error_Msg_File_1 := File_Name_Type (Token_Name);
- Error_Msg ("unknown project file: {", Token_Ptr);
+ Error_Msg_Name_1 := Token_Name;
+
+ Error_Msg ("unknown project file: %%", Token_Ptr);
-- If we are not in the main project file, display the
-- import path.
if Project_Stack.Last > 1 then
- Error_Msg_File_1 :=
- File_Name_Type
+ Error_Msg_Name_1 :=
+ Name_Id
(Project_Stack.Table (Project_Stack.Last).Path_Name);
- Error_Msg ("\extended by {", Token_Ptr);
+ Error_Msg ("\extended by %%", Token_Ptr);
for Index in reverse 1 .. Project_Stack.Last - 1 loop
- Error_Msg_File_1 :=
- File_Name_Type
+ Error_Msg_Name_1 :=
+ Name_Id
(Project_Stack.Table (Index).Path_Name);
- Error_Msg ("\imported by {", Token_Ptr);
+ Error_Msg ("\imported by %%", Token_Ptr);
end loop;
end if;
Extended => True,
From_Extended => From_Ext,
In_Limited => In_Limited,
- Packages_To_Check => Packages_To_Check);
+ Packages_To_Check => Packages_To_Check,
+ Depth => Depth + 1);
end;
-- A project that extends an extending-all project is also
Imported := Project_Node_Of (With_Clause, In_Tree);
if Is_Extending_All (With_Clause, In_Tree) then
- Error_Msg_File_1 :=
- File_Name_Type (Name_Of (Imported, In_Tree));
- Error_Msg ("cannot import extending-all project {",
+ Error_Msg_Name_1 := Name_Of (Imported, In_Tree);
+ Error_Msg ("cannot import extending-all project %%",
Token_Ptr);
exit With_Clause_Loop;
end if;
Name_Len := Name_Len - 1;
declare
- Parent_Name : constant File_Name_Type := Name_Find;
+ Parent_Name : constant Name_Id := Name_Find;
Parent_Found : Boolean := False;
With_Clause : Project_Node_Id :=
First_With_Clause_Of (Project, In_Tree);
if Extended_Project /= Empty_Node then
Parent_Found :=
- Name_Of (Extended_Project, In_Tree) = Name_Id (Parent_Name);
+ Name_Of (Extended_Project, In_Tree) = Parent_Name;
end if;
-- If the parent project is not the extended project,
while not Parent_Found and then With_Clause /= Empty_Node loop
Parent_Found :=
Name_Of (Project_Node_Of (With_Clause, In_Tree), In_Tree) =
- Name_Id (Parent_Name);
+ Parent_Name;
With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
end loop;
if not Parent_Found then
Error_Msg_Name_1 := Name_Of_Project;
- Error_Msg_File_1 := Parent_Name;
- Error_Msg ("project %% does not import or extend project {",
+ Error_Msg_Name_2 := Parent_Name;
+ Error_Msg ("project %% does not import or extend project %%",
Location_Of (Project, In_Tree));
end if;
end;
-- Project_Name_From --
-----------------------
- function Project_Name_From (Path_Name : String) return File_Name_Type is
+ function Project_Name_From (Path_Name : String) return Name_Id is
Canonical : String (1 .. Path_Name'Length) := Path_Name;
First : Natural := Canonical'Last;
Last : Natural := First;
-- If the path name is empty, return No_Name to indicate failure
if First = 0 then
- return No_File;
+ return No_Name;
end if;
Canonical_Case_File_Name (Canonical);
-- If we have a dot, check that it is followed by the correct extension
if First > 0 and then Canonical (First) = '.' then
- if Canonical (First .. Last) = Project_File_Extension
- and then First /= 1
+ if ((not In_Configuration) and then
+ Canonical (First .. Last) = Project_File_Extension and then
+ First /= 1)
+ or else
+ (In_Configuration and then
+ Canonical (First .. Last) = Config_Project_File_Extension and then
+ First /= 1)
then
-- Look for the last directory separator, if any
else
-- Not the correct extension, return No_Name to indicate failure
- return No_File;
+ return No_Name;
end if;
-- If no dot in the path name, return No_Name to indicate failure
else
- return No_File;
+ return No_Name;
end if;
First := First + 1;
-- If the extension is the file name, return No_Name to indicate failure
if First > Last then
- return No_File;
+ return No_Name;
end if;
-- Put the name in lower case into Name_Buffer
loop
if not Is_Letter (Name_Buffer (Index)) then
- return No_File;
+ return No_Name;
else
loop
if Name_Buffer (Index) = '_' then
if Name_Buffer (Index + 1) = '_' then
- return No_File;
+ return No_Name;
end if;
end if;
if Name_Buffer (Index) /= '_'
and then not Is_Alphanumeric (Name_Buffer (Index))
then
- return No_File;
+ return No_Name;
end if;
end loop;
return Name_Find;
else
- return No_File;
+ return No_Name;
end if;
elsif Name_Buffer (Index) = '-' then
OSDN Git Service
