Skip to content

R
riscv-gcc-1
Commit 6c1f47ee by Emmanuel Briot Committed by Arnaud Charlet
Options

prj.ads, prj.adb (Is_A_Language): Now takes a Name_Id instead of a string 

2007-12-06  Emmanuel Briot  <briot@adacore.com>
	    Vincent Celier  <celier@adacore.com>

	* prj.ads, prj.adb (Is_A_Language): Now takes a Name_Id instead of a
	string
	(Must_Check_Configuration, Default_Language_Is_Ada): new flags in
	prj.ads
	(Hash): Move instantiation of System.HTable.Hash from spec to body
	(prj-nmsc.adb): Optimize calls to Name_Find when on case sensitive
	systems, since we do not need to recompute the Name_Id for the canonical
	file name.
	(Body_Suffix_Id_Of, Spec_Suffix_Id_Of): new version that takes a name_id
	as a parameter. This parameter is in fact always "ada" in all calls, and
	we were doing 160560 extra calls to Name_Find to convert it to Name_Ada
	while loading a project with 40000 files

	* prj-attr.adb: Fix name of attribute Dependency_Driver
	Change the kind of indexing for attribute Root

	* prj-dect.adb (Parse_Declarative_Items): Allow redeclarations of
	variables already declared, in case constructions.

	* prj-env.adb (Initialize): Reset Current_Source_Path_File and
	Current_Object_Path_File to No_Path.

	* prj-ext.adb (Initialize_Project_Path): In multi language mode, use
	ADA_PROJECT_PATH if value of GPR_PROJECT_PATH is empty.

	* prj-makr.adb: new parameter Current_Dir

	* prj-nmsc.ads, prj-nmsc.adb (Find_Explicit_Sources): Do not look for
	Ada sources when language is not Ada.
	Change Opt.Follow_Links to Opt.Follow_Links_For_Files.
	(Find_Excluded_Sources, Find_Explicit_Sources): new subprograms
	(Must_Check_Configuration, Default_Language_Is_Ada): new flags.
	(Locate_Directory): Always resolve links when computing Canonical_Path
	(Look_For_Sources): Make sure that Name_Buffer contains the file name
	in Source_Files before checking for the presence of a directory
	separator.
	Optimize calls to Name_Find when on case sensitive systems.
	(Body_Suffix_Id_Of, Spec_Suffix_Id_Of): new version that takes a name_id
	as a parameter.
	(Prj.Nmsc.Check): new parameter Current_Dir
	(Check_Ada_Naming_Schemes): Restrictions on suffixes are relaxed. They
	cannot be empty and the spec suffix cannot be the same as the body or
	separate suffix.
	(Get_Unit): When a file name can be of several unit kinds (spec, body or
	subunit), always consider the longest suffix.
	(Check_Configuration): Do not issue an error if there is no compiler
	for a language. Just issue a warning and ignore the sources for the
	language.
	(Check_Library_Attributes): Only check Library_Dir if Library_Name is
	not empty.
	(Check_Naming_Schemes.Maked_Unit): Only output message if high verbosity
	(Unit_Exceptions): New hash table
	(Check_Naming_Schemes): Check if a file that could be a unit because of
	the naming scheme is not in fact a source because there is an exception
	for the unit.
	(Look_For_Sources): Put the unit exceptions in hash table
	Unit_Exceptions
	(Get_Unit_Exceptions): Give initial value No_Source to local variable
	Other_Part to avoid exception when code is compiled with validity
	checking.
	(Get_Sources_From_File): Check that there is no directory information
	in the file names.
	(Look_For_Sources): Check that there is no directory information in the
	list of file names in Source_Files.
	(Look_For_Sources): In multi-language mode, do not allow exception file
	names that are excluded.
	(Excluded_Sources_Htable): New hash table
	(Search_Directories.Check_File): New procedure to simplify
	Search_Directories.
	(Search_Directories): Do not consider excluded sources
	(Look_For_Sources): Populate Excluded_Sources_Htable before calling
	Search_Directories.
	(Get_Exceptions): Set component Lang_Kind of Source_Data
	(Get_Unit_Exceptions): Ditto
	(Search_Directories): Ditto

	* prj-pars.adb: new parameter Current_Dir

	* prj-part.ads, prj-part.adb: 
	Change Opt.Follow_Links to Opt.Follow_Links_For_Files.
	(Opt.Follow_Links_For_Dirs): New flag
	(Project_Path_Name_Of): Cache information returned by this routine as
	Locate_Regular_File is a costly routine. The code to output a log
	information and the effective call to Locate_Regular_File is now
	factorized into a routine (code clean-up).
	(Parse, Parse_Single_Project): new parameter Current_Dir
	When main project file cannot be found, indicate in the error
	message the project path that was used to do the search.

	* prj-proc.ads, prj-proc.adb (Opt.Follow_Links_For_Dirs): New flag
	(Prj.Proc.Process*): new parameter Current_Dir

	* switch-m.adb: Change Opt.Follow_Links to Opt.Follow_Links_For_Files

From-SVN: r130846
parent 800621e0
Showing with 568 additions and 303 deletions
gcc/ada/prj-attr.adb
...@@ -66,7 +66,7 @@ package body Prj.Attr is ...@@ -66,7 +66,7 @@ package body Prj.Attr is
"lVmain#" & "lVmain#" &
"LVlanguages#" & "LVlanguages#" &
"SVmain_language#" & "SVmain_language#" &
"Laroots#" & "Lbroots#" &
"SVexternally_built#" & "SVexternally_built#" &
-- Directories -- Directories
...@@ -178,7 +178,7 @@ package body Prj.Attr is ...@@ -178,7 +178,7 @@ package body Prj.Attr is
-- Configuration - Dependencies -- Configuration - Dependencies
"Ladependency_switches#" & "Ladependency_switches#" &
"Lacompute_dependency#" & "Ladependency_driver#" &
-- Configuration - Search paths -- Configuration - Search paths
......
gcc/ada/prj-dect.adb
...@@ -790,9 +790,8 @@ package body Prj.Dect is ...@@ -790,9 +790,8 @@ package body Prj.Dect is
Declarations := Empty_Node; Declarations := Empty_Node;
loop loop
-- We are always positioned at the token that precedes -- We are always positioned at the token that precedes the first
-- the first token of the declarative element. -- token of the declarative element. Scan past it.
-- Scan past it
Scan (In_Tree); Scan (In_Tree);
...@@ -802,8 +801,38 @@ package body Prj.Dect is ...@@ -802,8 +801,38 @@ package body Prj.Dect is
when Tok_Identifier => when Tok_Identifier =>
if In_Zone = In_Case_Construction then if In_Zone = In_Case_Construction then
Error_Msg ("a variable cannot be declared here",
Token_Ptr); -- Check if the variable has already been declared
declare
The_Variable : Project_Node_Id := Empty_Node;
begin
if Current_Package /= Empty_Node then
The_Variable :=
First_Variable_Of (Current_Package, In_Tree);
elsif Current_Project /= Empty_Node then
The_Variable :=
First_Variable_Of (Current_Project, In_Tree);
end if;
while The_Variable /= Empty_Node
and then Name_Of (The_Variable, In_Tree) /=
Token_Name
loop
The_Variable := Next_Variable (The_Variable, In_Tree);
end loop;
-- It is an error to declare a variable in a case
-- construction for the first time.
if The_Variable = Empty_Node then
Error_Msg
("a variable cannot be declared " &
"for the first time here",
Token_Ptr);
end if;
end;
end if; end if;
Parse_Variable_Declaration Parse_Variable_Declaration
......
gcc/ada/prj-env.adb
...@@ -1331,21 +1331,22 @@ package body Prj.Env is ...@@ -1331,21 +1331,22 @@ package body Prj.Env is
while Source /= No_Source loop while Source /= No_Source loop
Src_Data := In_Tree.Sources.Table (Source); Src_Data := In_Tree.Sources.Table (Source);
if Src_Data.Language_Name = Language and then if Src_Data.Language_Name = Language
(not Src_Data.Locally_Removed) and then and then not Src_Data.Locally_Removed
Src_Data.Replaced_By = No_Source and then and then Src_Data.Replaced_By = No_Source
Src_Data.Path /= No_Path and then Src_Data.Path /= No_Path
then then
if Src_Data.Unit /= No_Name then if Src_Data.Unit /= No_Name then
Get_Name_String (Src_Data.Unit); Get_Name_String (Src_Data.Unit);
if Src_Data.Kind = Spec then if Src_Data.Kind = Spec then
Suffix := In_Tree.Languages_Data.Table Suffix :=
(Src_Data.Language).Config.Mapping_Spec_Suffix; In_Tree.Languages_Data.Table
(Src_Data.Language).Config.Mapping_Spec_Suffix;
else else
Suffix := In_Tree.Languages_Data.Table Suffix :=
(Src_Data.Language).Config.Mapping_Body_Suffix; In_Tree.Languages_Data.Table
(Src_Data.Language).Config.Mapping_Body_Suffix;
end if; end if;
if Suffix /= No_File then if Suffix /= No_File then
...@@ -1956,6 +1957,8 @@ package body Prj.Env is ...@@ -1956,6 +1957,8 @@ package body Prj.Env is
procedure Initialize is procedure Initialize is
begin begin
Fill_Mapping_File := True; Fill_Mapping_File := True;
Current_Source_Path_File := No_Path;
Current_Object_Path_File := No_Path;
end Initialize; end Initialize;
------------------------------------ ------------------------------------
...@@ -2323,10 +2326,10 @@ package body Prj.Env is ...@@ -2323,10 +2326,10 @@ package body Prj.Env is
-- except if we don't include library project and this -- except if we don't include library project and this
-- is a library project. -- is a library project.
if (Data.Library and then Including_Libraries) if (Data.Library and Including_Libraries)
or else or else
(Data.Object_Directory /= No_Path (Data.Object_Directory /= No_Path
and then and then
(not Including_Libraries or else not Data.Library)) (not Including_Libraries or else not Data.Library))
then then
-- For a library project, add the library ALI -- For a library project, add the library ALI
......
gcc/ada/prj-ext.adb
...@@ -66,7 +66,6 @@ package body Prj.Ext is ...@@ -66,7 +66,6 @@ package body Prj.Ext is
-- first for external reference in this table, before checking the -- first for external reference in this table, before checking the
-- environment. Htable is emptied (reset) by procedure Reset. -- environment. Htable is emptied (reset) by procedure Reset.
---------
package Search_Directories is new Table.Table package Search_Directories is new Table.Table
(Table_Component_Type => Name_Id, (Table_Component_Type => Name_Id,
Table_Index_Type => Natural, Table_Index_Type => Natural,
...@@ -76,6 +75,7 @@ package body Prj.Ext is ...@@ -76,6 +75,7 @@ package body Prj.Ext is
Table_Name => "Prj.Ext.Search_Directories"); Table_Name => "Prj.Ext.Search_Directories");
-- The table for the directories specified with -aP switches -- The table for the directories specified with -aP switches
---------
-- Add -- -- Add --
--------- ---------
...@@ -142,20 +142,18 @@ package body Prj.Ext is ...@@ -142,20 +142,18 @@ package body Prj.Ext is
Prj_Path : String_Access := Gpr_Prj_Path; Prj_Path : String_Access := Gpr_Prj_Path;
begin begin
if Get_Mode = Ada_Only then if Gpr_Prj_Path.all /= "" then
if Gpr_Prj_Path.all /= "" then
-- Warn if both environment variables are defined
if Ada_Prj_Path.all /= "" then -- In Ada only mode, warn if both environment variables are defined
Write_Line
("Warning: ADA_PROJECT_PATH is not taken into account");
Write_Line (" when GPR_PROJECT_PATH is defined");
end if;
else if Get_Mode = Ada_Only and then Ada_Prj_Path.all /= "" then
Prj_Path := Ada_Prj_Path; Write_Line
("Warning: ADA_PROJECT_PATH is not taken into account");
Write_Line (" when GPR_PROJECT_PATH is defined");
end if; end if;
else
Prj_Path := Ada_Prj_Path;
end if; end if;
-- The current directory is always first -- The current directory is always first
......
gcc/ada/prj-makr.adb
...@@ -741,6 +741,7 @@ package body Prj.Makr is ...@@ -741,6 +741,7 @@ package body Prj.Makr is
Project_File_Name => Output_Name (1 .. Output_Name_Last), Project_File_Name => Output_Name (1 .. Output_Name_Last),
Always_Errout_Finalize => False, Always_Errout_Finalize => False,
Store_Comments => True, Store_Comments => True,
Current_Directory => Get_Current_Dir,
Packages_To_Check => Packages_To_Check_By_Gnatname); Packages_To_Check => Packages_To_Check_By_Gnatname);
-- Fail if parsing was not successful -- Fail if parsing was not successful
......
gcc/ada/prj-nmsc.adb
This source diff could not be displayed because it is too large. You can view the blob instead.
gcc/ada/prj-nmsc.ads
...@@ -35,8 +35,8 @@ private package Prj.Nmsc is ...@@ -35,8 +35,8 @@ private package Prj.Nmsc is
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Report_Error : Put_Line_Access; Report_Error : Put_Line_Access;
Follow_Links : Boolean; When_No_Sources : Error_Warning;
When_No_Sources : Error_Warning); Current_Dir : String);
-- Check the object directory and the source directories -- Check the object directory and the source directories
-- --
-- Check the library attributes, including the library directory if any -- Check the library attributes, including the library directory if any
...@@ -53,10 +53,7 @@ private package Prj.Nmsc is ...@@ -53,10 +53,7 @@ private package Prj.Nmsc is
-- If Report_Error is null , use the standard error reporting mechanism -- If Report_Error is null , use the standard error reporting mechanism
-- (Errout). Otherwise, report errors using Report_Error. -- (Errout). Otherwise, report errors using Report_Error.
-- --
-- If Follow_Links is False, it is assumed that the project doesn't contain -- Current_Dir is for optimization purposes only, avoiding system calls.
-- any file duplicated through symbolic links (although the latter are
-- still valid if they point to a file which is outside of the project),
-- and that no directory has a name which is a valid source name.
-- --
-- When_No_Sources indicates what should be done when no sources of a -- When_No_Sources indicates what should be done when no sources of a
-- language are found in a project where this language is declared. -- language are found in a project where this language is declared.
......
gcc/ada/prj-pars.adb
...@@ -24,8 +24,8 @@ ...@@ -24,8 +24,8 @@
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Ada.Exceptions; use Ada.Exceptions; with Ada.Exceptions; use Ada.Exceptions;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with Opt;
with Output; use Output; with Output; use Output;
with Prj.Err; use Prj.Err; with Prj.Err; use Prj.Err;
with Prj.Part; with Prj.Part;
...@@ -52,6 +52,7 @@ package body Prj.Pars is ...@@ -52,6 +52,7 @@ package body Prj.Pars is
Project_Node : Project_Node_Id := Empty_Node; Project_Node : Project_Node_Id := Empty_Node;
The_Project : Project_Id := No_Project; The_Project : Project_Id := No_Project;
Success : Boolean := True; Success : Boolean := True;
Current_Dir : constant String := Get_Current_Dir;
begin begin
Prj.Tree.Initialize (Project_Node_Tree); Prj.Tree.Initialize (Project_Node_Tree);
...@@ -64,7 +65,8 @@ package body Prj.Pars is ...@@ -64,7 +65,8 @@ package body Prj.Pars is
Project => Project_Node, Project => Project_Node,
Project_File_Name => Project_File_Name, Project_File_Name => Project_File_Name,
Always_Errout_Finalize => False, Always_Errout_Finalize => False,
Packages_To_Check => Packages_To_Check); Packages_To_Check => Packages_To_Check,
Current_Directory => Current_Dir);
-- If there were no error, process the tree -- If there were no error, process the tree
...@@ -76,9 +78,9 @@ package body Prj.Pars is ...@@ -76,9 +78,9 @@ package body Prj.Pars is
From_Project_Node => Project_Node, From_Project_Node => Project_Node,
From_Project_Node_Tree => Project_Node_Tree, From_Project_Node_Tree => Project_Node_Tree,
Report_Error => null, Report_Error => null,
Follow_Links => Opt.Follow_Links,
When_No_Sources => When_No_Sources, When_No_Sources => When_No_Sources,
Reset_Tree => Reset_Tree); Reset_Tree => Reset_Tree,
Current_Dir => Current_Dir);
Prj.Err.Finalize; Prj.Err.Finalize;
if not Success then if not Success then
......
gcc/ada/prj-part.adb
...@@ -39,8 +39,6 @@ with Table; ...@@ -39,8 +39,6 @@ with Table;
with Ada.Characters.Handling; use Ada.Characters.Handling; with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Exceptions; use Ada.Exceptions; with Ada.Exceptions; use Ada.Exceptions;
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 package body Prj.Part is
...@@ -48,7 +46,7 @@ package body Prj.Part is ...@@ -48,7 +46,7 @@ package body Prj.Part is
Buffer : String_Access; Buffer : String_Access;
Buffer_Last : Natural := 0; Buffer_Last : Natural := 0;
Dir_Sep : Character renames GNAT.OS_Lib.Directory_Separator; Dir_Sep : Character renames GNAT.OS_Lib.Directory_Separator;
------------------------------------ ------------------------------------
-- Local Packages and Subprograms -- -- Local Packages and Subprograms --
...@@ -116,6 +114,15 @@ package body Prj.Part is ...@@ -116,6 +114,15 @@ package body Prj.Part is
-- need to have a virtual extending project, to avoid processing the same -- need to have a virtual extending project, to avoid processing the same
-- project twice. -- project twice.
package Projects_Paths is new System.HTable.Simple_HTable
(Header_Num => Header_Num,
Element => Path_Name_Type,
No_Element => No_Path,
Key => Name_Id,
Hash => Hash,
Equal => "=");
-- Hash table to cache project path to avoid looking for them on the path
procedure Create_Virtual_Extending_Project procedure Create_Virtual_Extending_Project
(For_Project : Project_Node_Id; (For_Project : Project_Node_Id;
Main_Project : Project_Node_Id; Main_Project : Project_Node_Id;
...@@ -153,7 +160,8 @@ package body Prj.Part is ...@@ -153,7 +160,8 @@ package body Prj.Part is
From_Extended : Extension_Origin; From_Extended : Extension_Origin;
In_Limited : Boolean; In_Limited : Boolean;
Packages_To_Check : String_List_Access; Packages_To_Check : String_List_Access;
Depth : Natural); Depth : Natural;
Current_Dir : String);
-- Parse the imported projects that have been stored in table Withs, -- Parse the imported projects that have been stored in table Withs,
-- if any. From_Extended is used for the call to Parse_Single_Project -- 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 -- below. When In_Limited is True, the importing path includes at least
...@@ -327,8 +335,7 @@ package body Prj.Part is ...@@ -327,8 +335,7 @@ package body Prj.Part is
---------------------------- ----------------------------
function Immediate_Directory_Of function Immediate_Directory_Of
(Path_Name : Path_Name_Type) (Path_Name : Path_Name_Type) return Path_Name_Type
return Path_Name_Type
is is
begin begin
Get_Name_String (Path_Name); Get_Name_String (Path_Name);
...@@ -366,7 +373,6 @@ package body Prj.Part is ...@@ -366,7 +373,6 @@ package body Prj.Part is
(Proj : Project_Node_Id; (Proj : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref; In_Tree : Project_Node_Tree_Ref;
Potentially_Virtual : Boolean) Potentially_Virtual : Boolean)
is is
Declaration : Project_Node_Id := Empty_Node; Declaration : Project_Node_Id := Empty_Node;
-- Node for the project declaration of Proj -- Node for the project declaration of Proj
...@@ -436,10 +442,9 @@ package body Prj.Part is ...@@ -436,10 +442,9 @@ package body Prj.Part is
Project_File_Name : String; Project_File_Name : String;
Always_Errout_Finalize : Boolean; Always_Errout_Finalize : Boolean;
Packages_To_Check : String_List_Access := All_Packages; Packages_To_Check : String_List_Access := All_Packages;
Store_Comments : Boolean := False) Store_Comments : Boolean := False;
Current_Directory : String := "")
is is
Current_Directory : constant String := Get_Current_Dir;
Dummy : Boolean; Dummy : Boolean;
pragma Warnings (Off, Dummy); pragma Warnings (Off, Dummy);
...@@ -454,6 +459,8 @@ package body Prj.Part is ...@@ -454,6 +459,8 @@ package body Prj.Part is
Project := Empty_Node; Project := Empty_Node;
Projects_Paths.Reset;
if Current_Verbosity >= Medium then if Current_Verbosity >= Medium then
Write_Str ("GPR_PROJECT_PATH="""); Write_Str ("GPR_PROJECT_PATH=""");
Write_Str (Project_Path); Write_Str (Project_Path);
...@@ -476,7 +483,9 @@ package body Prj.Part is ...@@ -476,7 +483,9 @@ package body Prj.Part is
if Path_Name = "" then if Path_Name = "" then
Prj.Com.Fail Prj.Com.Fail
("project file """, Project_File_Name, """ not found"); ("project file """,
Project_File_Name,
""" not found in " & Project_Path);
Project := Empty_Node; Project := Empty_Node;
return; return;
end if; end if;
...@@ -490,7 +499,8 @@ package body Prj.Part is ...@@ -490,7 +499,8 @@ package body Prj.Part is
From_Extended => None, From_Extended => None,
In_Limited => False, In_Limited => False,
Packages_To_Check => Packages_To_Check, Packages_To_Check => Packages_To_Check,
Depth => 0); Depth => 0,
Current_Dir => Current_Directory);
-- If Project is an extending-all project, create the eventual -- If Project is an extending-all project, create the eventual
-- virtual extending projects and check that there are no illegally -- virtual extending projects and check that there are no illegally
...@@ -601,12 +611,10 @@ package body Prj.Part is ...@@ -601,12 +611,10 @@ package body Prj.Part is
(In_Tree : Project_Node_Tree_Ref; (In_Tree : Project_Node_Tree_Ref;
Context_Clause : out With_Id) Context_Clause : out With_Id)
is is
Current_With_Clause : With_Id := No_With; Current_With_Clause : With_Id := No_With;
Limited_With : Boolean := False; Limited_With : Boolean := False;
Current_With : With_Record;
Current_With : With_Record; Current_With_Node : Project_Node_Id := Empty_Node;
Current_With_Node : Project_Node_Id := Empty_Node;
begin begin
-- Assume no context clause -- Assume no context clause
...@@ -704,7 +712,8 @@ package body Prj.Part is ...@@ -704,7 +712,8 @@ package body Prj.Part is
From_Extended : Extension_Origin; From_Extended : Extension_Origin;
In_Limited : Boolean; In_Limited : Boolean;
Packages_To_Check : String_List_Access; Packages_To_Check : String_List_Access;
Depth : Natural) Depth : Natural;
Current_Dir : String)
is is
Current_With_Clause : With_Id := Context_Clause; Current_With_Clause : With_Id := Context_Clause;
...@@ -739,7 +748,8 @@ package body Prj.Part is ...@@ -739,7 +748,8 @@ package body Prj.Part is
Resolved_Path : constant String := Resolved_Path : constant String :=
Normalize_Pathname Normalize_Pathname
(Imported_Path_Name, (Imported_Path_Name,
Resolve_Links => True, Directory => Current_Dir,
Resolve_Links => Opt.Follow_Links_For_Files,
Case_Sensitive => True); Case_Sensitive => True);
Withed_Project : Project_Node_Id := Empty_Node; Withed_Project : Project_Node_Id := Empty_Node;
...@@ -828,7 +838,8 @@ package body Prj.Part is ...@@ -828,7 +838,8 @@ package body Prj.Part is
From_Extended => From_Extended, From_Extended => From_Extended,
In_Limited => Limited_With, In_Limited => Limited_With,
Packages_To_Check => Packages_To_Check, Packages_To_Check => Packages_To_Check,
Depth => Depth); Depth => Depth,
Current_Dir => Current_Dir);
else else
Extends_All := Is_Extending_All (Withed_Project, In_Tree); Extends_All := Is_Extending_All (Withed_Project, In_Tree);
...@@ -887,7 +898,8 @@ package body Prj.Part is ...@@ -887,7 +898,8 @@ package body Prj.Part is
From_Extended : Extension_Origin; From_Extended : Extension_Origin;
In_Limited : Boolean; In_Limited : Boolean;
Packages_To_Check : String_List_Access; Packages_To_Check : String_List_Access;
Depth : Natural) Depth : Natural;
Current_Dir : String)
is is
Normed_Path_Name : Path_Name_Type; Normed_Path_Name : Path_Name_Type;
Canonical_Path_Name : Path_Name_Type; Canonical_Path_Name : Path_Name_Type;
...@@ -918,11 +930,15 @@ package body Prj.Part is ...@@ -918,11 +930,15 @@ package body Prj.Part is
declare declare
Normed_Path : constant String := Normalize_Pathname Normed_Path : constant String := Normalize_Pathname
(Path_Name, Resolve_Links => False, (Path_Name,
Case_Sensitive => True); Directory => Current_Dir,
Resolve_Links => False,
Case_Sensitive => True);
Canonical_Path : constant String := Normalize_Pathname Canonical_Path : constant String := Normalize_Pathname
(Normed_Path, Resolve_Links => True, (Normed_Path,
Case_Sensitive => False); Directory => Current_Dir,
Resolve_Links => Opt.Follow_Links_For_Files,
Case_Sensitive => False);
begin begin
Name_Len := Normed_Path'Length; Name_Len := Normed_Path'Length;
...@@ -1224,16 +1240,17 @@ package body Prj.Part is ...@@ -1224,16 +1240,17 @@ package body Prj.Part is
From_Extended => From_Ext, From_Extended => From_Ext,
In_Limited => In_Limited, In_Limited => In_Limited,
Packages_To_Check => Packages_To_Check, Packages_To_Check => Packages_To_Check,
Depth => Depth + 1); Depth => Depth + 1,
Current_Dir => Current_Dir);
Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects); Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects);
end; end;
if not In_Configuration then if not In_Configuration then
declare declare
Name_And_Node : Tree_Private_Part.Project_Name_And_Node := Name_And_Node : Tree_Private_Part.Project_Name_And_Node :=
Tree_Private_Part.Projects_Htable.Get_First Tree_Private_Part.Projects_Htable.Get_First
(In_Tree.Projects_HT); (In_Tree.Projects_HT);
Project_Name : Name_Id := Name_And_Node.Name; Project_Name : Name_Id := Name_And_Node.Name;
begin begin
-- Check if we already have a project with this name -- Check if we already have a project with this name
...@@ -1340,7 +1357,8 @@ package body Prj.Part is ...@@ -1340,7 +1357,8 @@ package body Prj.Part is
From_Extended => From_Ext, From_Extended => From_Ext,
In_Limited => In_Limited, In_Limited => In_Limited,
Packages_To_Check => Packages_To_Check, Packages_To_Check => Packages_To_Check,
Depth => Depth + 1); Depth => Depth + 1,
Current_Dir => Current_Dir);
end; end;
-- A project that extends an extending-all project is also -- A project that extends an extending-all project is also
...@@ -1561,9 +1579,9 @@ package body Prj.Part is ...@@ -1561,9 +1579,9 @@ package body Prj.Part is
function Project_Name_From (Path_Name : String) return Name_Id is function Project_Name_From (Path_Name : String) return Name_Id is
Canonical : String (1 .. Path_Name'Length) := Path_Name; Canonical : String (1 .. Path_Name'Length) := Path_Name;
First : Natural := Canonical'Last; First : Natural := Canonical'Last;
Last : Natural := First; Last : Natural := First;
Index : Positive; Index : Positive;
begin begin
if Current_Verbosity = High then if Current_Verbosity = High then
...@@ -1694,7 +1712,35 @@ package body Prj.Part is ...@@ -1694,7 +1712,35 @@ package body Prj.Part is
(Project_File_Name : String; (Project_File_Name : String;
Directory : String) return String Directory : String) return String
is is
Result : String_Access;
function Try_Path_Name (Path : String) return String_Access;
pragma Inline (Try_Path_Name);
-- Try the specified Path
-------------------
-- Try_Path_Name --
-------------------
function Try_Path_Name (Path : String) return String_Access is
begin
if Current_Verbosity = High then
Write_Str (" Trying ");
Write_Str (Path);
end if;
return Locate_Regular_File
(File_Name => Path,
Path => Project_Path);
end Try_Path_Name;
-- Local Declarations
Result : String_Access;
Result_Id : Path_Name_Type;
Has_Dot : Boolean := False;
Key : Name_Id;
-- Start of processing for Project_Path_Name_Of
begin begin
if Current_Verbosity = High then if Current_Verbosity = High then
...@@ -1705,70 +1751,60 @@ package body Prj.Part is ...@@ -1705,70 +1751,60 @@ package body Prj.Part is
Write_Line (""");"); Write_Line (""");");
end if; end if;
if not Is_Absolute_Path (Project_File_Name) then -- Check the project cache
-- First we try <directory>/<file_name>.<extension>
if Current_Verbosity = High then Name_Len := Project_File_Name'Length;
Write_Str (" Trying "); Name_Buffer (1 .. Name_Len) := Project_File_Name;
Write_Str (Directory); Key := Name_Find;
Write_Char (Directory_Separator); Result_Id := Projects_Paths.Get (Key);
Write_Str (Project_File_Name);
Write_Line (Project_File_Extension);
end if;
Result := if Result_Id /= No_Path then
Locate_Regular_File return Get_Name_String (Result_Id);
(File_Name => Directory & Directory_Separator & end if;
Project_File_Name & Project_File_Extension,
Path => Project_Path);
-- Then we try <directory>/<file_name> -- Check if Project_File_Name contains an extension (a dot before a
-- directory separator). If it is the case we do not try project file
-- with an added extension as it is not possible to have multiple dots
-- on a project file name.
if Result = null then Check_Dot : for K in reverse Project_File_Name'Range loop
if Current_Verbosity = High then if Project_File_Name (K) = '.' then
Write_Str (" Trying "); Has_Dot := True;
Write_Str (Directory); exit Check_Dot;
Write_Char (Directory_Separator);
Write_Line (Project_File_Name);
end if;
Result :=
Locate_Regular_File
(File_Name => Directory & Directory_Separator &
Project_File_Name,
Path => Project_Path);
end if; end if;
end if;
if Result = null then exit Check_Dot when Project_File_Name (K) = Directory_Separator
or else Project_File_Name (K) = '/';
end loop Check_Dot;
-- Then we try <file_name>.<extension> if not Is_Absolute_Path (Project_File_Name) then
if Current_Verbosity = High then -- First we try <directory>/<file_name>.<extension>
Write_Str (" Trying ");
Write_Str (Project_File_Name); if not Has_Dot then
Write_Line (Project_File_Extension); Result := Try_Path_Name
(Directory & Directory_Separator &
Project_File_Name & Project_File_Extension);
end if; end if;
Result := -- Then we try <directory>/<file_name>
Locate_Regular_File
(File_Name => Project_File_Name & Project_File_Extension, if Result = null then
Path => Project_Path); Result := Try_Path_Name
(Directory & Directory_Separator & Project_File_Name);
end if;
end if; end if;
if Result = null then -- Then we try <file_name>.<extension>
-- Then we try <file_name> if Result = null and then not Has_Dot then
Result := Try_Path_Name (Project_File_Name & Project_File_Extension);
end if;
if Current_Verbosity = High then -- Then we try <file_name>
Write_Str (" Trying ");
Write_Line (Project_File_Name);
end if;
Result := if Result = null then
Locate_Regular_File Result := Try_Path_Name (Project_File_Name);
(File_Name => Project_File_Name,
Path => Project_Path);
end if; end if;
-- If we cannot find the project file, we return an empty string -- If we cannot find the project file, we return an empty string
...@@ -1781,10 +1817,16 @@ package body Prj.Part is ...@@ -1781,10 +1817,16 @@ package body Prj.Part is
Final_Result : constant String := Final_Result : constant String :=
GNAT.OS_Lib.Normalize_Pathname GNAT.OS_Lib.Normalize_Pathname
(Result.all, (Result.all,
Directory => Directory,
Resolve_Links => False, Resolve_Links => False,
Case_Sensitive => True); Case_Sensitive => True);
begin begin
Free (Result); Free (Result);
Name_Len := Final_Result'Length;
Name_Buffer (1 .. Name_Len) := Final_Result;
Result_Id := Name_Find;
Projects_Paths.Set (Key, Result_Id);
return Final_Result; return Final_Result;
end; end;
end if; end if;
......
gcc/ada/prj-part.ads
...@@ -35,7 +35,8 @@ package Prj.Part is ...@@ -35,7 +35,8 @@ package Prj.Part is
Project_File_Name : String; Project_File_Name : String;
Always_Errout_Finalize : Boolean; Always_Errout_Finalize : Boolean;
Packages_To_Check : String_List_Access := All_Packages; Packages_To_Check : String_List_Access := All_Packages;
Store_Comments : Boolean := False); Store_Comments : Boolean := False;
Current_Directory : String := "");
-- Parse project file and all its imported project files and create a tree. -- Parse project file and all its imported project files and create a tree.
-- Return the node for the project (or Empty_Node if parsing failed). If -- Return the node for the project (or Empty_Node if parsing failed). If
-- Always_Errout_Finalize is True, Errout.Finalize is called in all cases, -- Always_Errout_Finalize is True, Errout.Finalize is called in all cases,
...@@ -44,6 +45,9 @@ package Prj.Part is ...@@ -44,6 +45,9 @@ package Prj.Part is
-- where any unknown attribute produces an error. For other packages, an -- where any unknown attribute produces an error. For other packages, an
-- unknown attribute produces a warning. When Store_Comments is True, -- unknown attribute produces a warning. When Store_Comments is True,
-- comments are stored in the parse tree. -- comments are stored in the parse tree.
--
-- Current_Directory is used for optimization purposes only, avoiding extra
-- system calls.
type Extension_Origin is (None, Extending_Simple, Extending_All); type Extension_Origin is (None, Extending_Simple, Extending_All);
-- Type of parameter From_Extended for procedures Parse_Single_Project and -- Type of parameter From_Extended for procedures Parse_Single_Project and
...@@ -59,7 +63,8 @@ package Prj.Part is ...@@ -59,7 +63,8 @@ package Prj.Part is
From_Extended : Extension_Origin; From_Extended : Extension_Origin;
In_Limited : Boolean; In_Limited : Boolean;
Packages_To_Check : String_List_Access; Packages_To_Check : String_List_Access;
Depth : Natural); Depth : Natural;
Current_Dir : String);
-- Parse a project file. -- Parse a project file.
-- Recursive procedure: it calls itself for imported and extended -- Recursive procedure: it calls itself for imported and extended
-- projects. When From_Extended is not None, if the project has already -- projects. When From_Extended is not None, if the project has already
......
gcc/ada/prj-proc.adb
...@@ -77,10 +77,11 @@ package body Prj.Proc is ...@@ -77,10 +77,11 @@ package body Prj.Proc is
procedure Check procedure Check
(In_Tree : Project_Tree_Ref; (In_Tree : Project_Tree_Ref;
Project : Project_Id; Project : Project_Id;
Follow_Links : Boolean; Current_Dir : String;
When_No_Sources : Error_Warning); When_No_Sources : Error_Warning);
-- Set all projects to not checked, then call Recursive_Check for the -- Set all projects to not checked, then call Recursive_Check for the
-- main project Project. Project is set to No_Project if errors occurred. -- main project Project. Project is set to No_Project if errors occurred.
-- Current_Dir is for optimization purposes, avoiding extra system calls.
procedure Copy_Package_Declarations procedure Copy_Package_Declarations
(From : Declarations; (From : Declarations;
...@@ -140,11 +141,12 @@ package body Prj.Proc is ...@@ -140,11 +141,12 @@ package body Prj.Proc is
procedure Recursive_Check procedure Recursive_Check
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Follow_Links : Boolean; Current_Dir : String;
When_No_Sources : Error_Warning); When_No_Sources : Error_Warning);
-- If Project is not marked as checked, mark it as checked, call -- If Project is not marked as checked, mark it as checked, call
-- Check_Naming_Scheme for the project, then call itself for a -- Check_Naming_Scheme for the project, then call itself for a
-- possible extended project and all the imported projects of Project. -- possible extended project and all the imported projects of Project.
-- Current_Dir is for optimization purposes, avoiding extra system calls.
--------- ---------
-- Add -- -- Add --
...@@ -258,7 +260,7 @@ package body Prj.Proc is ...@@ -258,7 +260,7 @@ package body Prj.Proc is
procedure Check procedure Check
(In_Tree : Project_Tree_Ref; (In_Tree : Project_Tree_Ref;
Project : Project_Id; Project : Project_Id;
Follow_Links : Boolean; Current_Dir : String;
When_No_Sources : Error_Warning) When_No_Sources : Error_Warning)
is is
begin begin
...@@ -270,8 +272,7 @@ package body Prj.Proc is ...@@ -270,8 +272,7 @@ package body Prj.Proc is
In_Tree.Projects.Table (Index).Checked := False; In_Tree.Projects.Table (Index).Checked := False;
end loop; end loop;
Recursive_Check Recursive_Check (Project, In_Tree, Current_Dir, When_No_Sources);
(Project, In_Tree, Follow_Links, When_No_Sources);
-- Set the Other_Part field for the units -- Set the Other_Part field for the units
...@@ -1209,9 +1210,9 @@ package body Prj.Proc is ...@@ -1209,9 +1210,9 @@ package body Prj.Proc is
From_Project_Node : Project_Node_Id; From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref; From_Project_Node_Tree : Project_Node_Tree_Ref;
Report_Error : Put_Line_Access; Report_Error : Put_Line_Access;
Follow_Links : Boolean := True;
When_No_Sources : Error_Warning := Error; When_No_Sources : Error_Warning := Error;
Reset_Tree : Boolean := True) Reset_Tree : Boolean := True;
Current_Dir : String := "")
is is
begin begin
Process_Project_Tree_Phase_1 Process_Project_Tree_Phase_1
...@@ -1231,8 +1232,8 @@ package body Prj.Proc is ...@@ -1231,8 +1232,8 @@ package body Prj.Proc is
From_Project_Node => From_Project_Node, From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree, From_Project_Node_Tree => From_Project_Node_Tree,
Report_Error => Report_Error, Report_Error => Report_Error,
Follow_Links => Follow_Links, When_No_Sources => When_No_Sources,
When_No_Sources => When_No_Sources); Current_Dir => Current_Dir);
end if; end if;
end Process; end Process;
...@@ -2292,8 +2293,8 @@ package body Prj.Proc is ...@@ -2292,8 +2293,8 @@ package body Prj.Proc is
From_Project_Node : Project_Node_Id; From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref; From_Project_Node_Tree : Project_Node_Tree_Ref;
Report_Error : Put_Line_Access; Report_Error : Put_Line_Access;
Follow_Links : Boolean := True; When_No_Sources : Error_Warning := Error;
When_No_Sources : Error_Warning := Error) Current_Dir : String)
is is
Obj_Dir : Path_Name_Type; Obj_Dir : Path_Name_Type;
Extending : Project_Id; Extending : Project_Id;
...@@ -2306,8 +2307,7 @@ package body Prj.Proc is ...@@ -2306,8 +2307,7 @@ package body Prj.Proc is
Success := True; Success := True;
if Project /= No_Project then if Project /= No_Project then
Check Check (In_Tree, Project, Current_Dir, When_No_Sources);
(In_Tree, Project, Follow_Links, When_No_Sources);
end if; end if;
-- If main project is an extending all project, set the object -- If main project is an extending all project, set the object
...@@ -2428,7 +2428,7 @@ package body Prj.Proc is ...@@ -2428,7 +2428,7 @@ package body Prj.Proc is
procedure Recursive_Check procedure Recursive_Check
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Follow_Links : Boolean; Current_Dir : String;
When_No_Sources : Error_Warning) When_No_Sources : Error_Warning)
is is
Data : Project_Data; Data : Project_Data;
...@@ -2451,8 +2451,7 @@ package body Prj.Proc is ...@@ -2451,8 +2451,7 @@ package body Prj.Proc is
-- Call itself for a possible extended project. -- Call itself for a possible extended project.
-- (if there is no extended project, then nothing happens). -- (if there is no extended project, then nothing happens).
Recursive_Check Recursive_Check (Data.Extends, In_Tree, Current_Dir, When_No_Sources);
(Data.Extends, In_Tree, Follow_Links, When_No_Sources);
-- Call itself for all imported projects -- Call itself for all imported projects
...@@ -2461,7 +2460,7 @@ package body Prj.Proc is ...@@ -2461,7 +2460,7 @@ package body Prj.Proc is
Recursive_Check Recursive_Check
(In_Tree.Project_Lists.Table (In_Tree.Project_Lists.Table
(Imported_Project_List).Project, (Imported_Project_List).Project,
In_Tree, Follow_Links, When_No_Sources); In_Tree, Current_Dir, When_No_Sources);
Imported_Project_List := Imported_Project_List :=
In_Tree.Project_Lists.Table In_Tree.Project_Lists.Table
(Imported_Project_List).Next; (Imported_Project_List).Next;
...@@ -2474,7 +2473,8 @@ package body Prj.Proc is ...@@ -2474,7 +2473,8 @@ package body Prj.Proc is
end if; end if;
Prj.Nmsc.Check Prj.Nmsc.Check
(Project, In_Tree, Error_Report, Follow_Links, When_No_Sources); (Project, In_Tree, Error_Report, When_No_Sources,
Current_Dir);
end if; end if;
end Recursive_Check; end Recursive_Check;
......
gcc/ada/prj-proc.ads
...@@ -38,17 +38,14 @@ package Prj.Proc is ...@@ -38,17 +38,14 @@ package Prj.Proc is
From_Project_Node : Project_Node_Id; From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref; From_Project_Node_Tree : Project_Node_Tree_Ref;
Report_Error : Put_Line_Access; Report_Error : Put_Line_Access;
Follow_Links : Boolean := True;
When_No_Sources : Error_Warning := Error; When_No_Sources : Error_Warning := Error;
Reset_Tree : Boolean := True); Reset_Tree : Boolean := True;
Current_Dir : String := "");
-- Process a project file tree into project file data structures. If -- Process a project file tree into project file data structures. If
-- Report_Error is null, use the error reporting mechanism. Otherwise, -- Report_Error is null, use the error reporting mechanism. Otherwise,
-- report errors using Report_Error. -- report errors using Report_Error.
-- --
-- If Follow_Links is False, it is assumed that the project doesn't contain -- Current_Dir is for optimization purposes, avoiding extra system calls.
-- any file duplicated through symbolic links (although the latter are
-- still valid if they point to a file which is outside of the project),
-- and that no directory has a name which is a valid source name.
-- --
-- When_No_Sources indicates what should be done when no sources are found -- When_No_Sources indicates what should be done when no sources are found
-- in a project for a specified or implied language. -- in a project for a specified or implied language.
...@@ -79,8 +76,8 @@ package Prj.Proc is ...@@ -79,8 +76,8 @@ package Prj.Proc is
From_Project_Node : Project_Node_Id; From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref; From_Project_Node_Tree : Project_Node_Tree_Ref;
Report_Error : Put_Line_Access; Report_Error : Put_Line_Access;
Follow_Links : Boolean := True; When_No_Sources : Error_Warning := Error;
When_No_Sources : Error_Warning := Error); Current_Dir : String);
-- See documentation of parameters in procedure Process above -- See documentation of parameters in procedure Process above
end Prj.Proc; end Prj.Proc;
gcc/ada/prj.adb
...@@ -232,10 +232,6 @@ package body Prj is ...@@ -232,10 +232,6 @@ package body Prj is
Naming : Naming_Data) return File_Name_Type Naming : Naming_Data) return File_Name_Type
is is
Language_Id : Name_Id; Language_Id : Name_Id;
Element_Id : Array_Element_Id;
Element : Array_Element;
Suffix : File_Name_Type := No_File;
Lang : Language_Index;
begin begin
Name_Len := 0; Name_Len := 0;
...@@ -243,6 +239,29 @@ package body Prj is ...@@ -243,6 +239,29 @@ package body Prj is
To_Lower (Name_Buffer (1 .. Name_Len)); To_Lower (Name_Buffer (1 .. Name_Len));
Language_Id := Name_Find; Language_Id := Name_Find;
return
Body_Suffix_Id_Of
(In_Tree => In_Tree,
Language_Id => Language_Id,
Naming => Naming);
end Body_Suffix_Id_Of;
-----------------------
-- Body_Suffix_Id_Of --
-----------------------
function Body_Suffix_Id_Of
(In_Tree : Project_Tree_Ref;
Language_Id : Name_Id;
Naming : Naming_Data) return File_Name_Type
is
Element_Id : Array_Element_Id;
Element : Array_Element;
Suffix : File_Name_Type := No_File;
Lang : Language_Index;
begin
-- ??? This seems to be only for Ada_Only mode...
Element_Id := Naming.Body_Suffix; Element_Id := Naming.Body_Suffix;
while Element_Id /= No_Array_Element loop while Element_Id /= No_Array_Element loop
Element := In_Tree.Array_Elements.Table (Element_Id); Element := In_Tree.Array_Elements.Table (Element_Id);
...@@ -526,8 +545,7 @@ package body Prj is ...@@ -526,8 +545,7 @@ package body Prj is
In_Tree.Projects.Table (Project).Seen := True; In_Tree.Projects.Table (Project).Seen := True;
Action (Project, With_State); Action (Project, With_State);
List := List := In_Tree.Projects.Table (Project).Imported_Projects;
In_Tree.Projects.Table (Project).Imported_Projects;
while List /= Empty_Project_List loop while List /= Empty_Project_List loop
Recursive_Check (In_Tree.Project_Lists.Table (List).Project); Recursive_Check (In_Tree.Project_Lists.Table (List).Project);
List := In_Tree.Project_Lists.Table (List).Next; List := In_Tree.Project_Lists.Table (List).Next;
...@@ -560,6 +578,9 @@ package body Prj is ...@@ -560,6 +578,9 @@ package body Prj is
-- Hash -- -- Hash --
---------- ----------
function Hash is new System.HTable.Hash (Header_Num => Header_Num);
-- Used in implementation of other functions Hash below
function Hash (Name : File_Name_Type) return Header_Num is function Hash (Name : File_Name_Type) return Header_Num is
begin begin
return Hash (Get_Name_String (Name)); return Hash (Get_Name_String (Name));
...@@ -644,25 +665,16 @@ package body Prj is ...@@ -644,25 +665,16 @@ package body Prj is
function Is_A_Language function Is_A_Language
(Tree : Project_Tree_Ref; (Tree : Project_Tree_Ref;
Data : Project_Data; Data : Project_Data;
Language_Name : String) return Boolean Language_Name : Name_Id) return Boolean
is is
Lang_Id : Name_Id;
begin begin
Name_Len := 0;
Add_Str_To_Name_Buffer (Language_Name);
To_Lower (Name_Buffer (1 .. Name_Len));
Lang_Id := Name_Find;
if Get_Mode = Ada_Only then if Get_Mode = Ada_Only then
declare declare
List : Name_List_Index := Data.Languages; List : Name_List_Index := Data.Languages;
begin begin
while List /= No_Name_List loop while List /= No_Name_List loop
if Tree.Name_Lists.Table (List).Name = Lang_Id then if Tree.Name_Lists.Table (List).Name = Language_Name then
return True; return True;
else else
List := Tree.Name_Lists.Table (List).Next; List := Tree.Name_Lists.Table (List).Next;
end if; end if;
...@@ -671,15 +683,14 @@ package body Prj is ...@@ -671,15 +683,14 @@ package body Prj is
else else
declare declare
Lang_Ind : Language_Index; Lang_Ind : Language_Index := Data.First_Language_Processing;
Lang_Data : Language_Data; Lang_Data : Language_Data;
begin begin
Lang_Ind := Data.First_Language_Processing;
while Lang_Ind /= No_Language_Index loop while Lang_Ind /= No_Language_Index loop
Lang_Data := Tree.Languages_Data.Table (Lang_Ind); Lang_Data := Tree.Languages_Data.Table (Lang_Ind);
if Lang_Data.Name = Lang_Id then if Lang_Data.Name = Language_Name then
return True; return True;
end if; end if;
...@@ -734,10 +745,11 @@ package body Prj is ...@@ -734,10 +745,11 @@ package body Prj is
when others => when others =>
declare declare
Supp : Supp_Language; Supp : Supp_Language;
Supp_Index : Supp_Language_Index := In_Project.Supp_Languages; Supp_Index : Supp_Language_Index;
begin begin
Supp_Index := In_Project.Supp_Languages;
while Supp_Index /= No_Supp_Language_Index loop while Supp_Index /= No_Supp_Language_Index loop
Supp := In_Tree.Present_Languages.Table (Supp_Index); Supp := In_Tree.Present_Languages.Table (Supp_Index);
...@@ -772,11 +784,11 @@ package body Prj is ...@@ -772,11 +784,11 @@ package body Prj is
when others => when others =>
declare declare
Supp : Supp_Language_Data; Supp : Supp_Language_Data;
Supp_Index : Supp_Language_Index := Supp_Index : Supp_Language_Index;
In_Project.Supp_Language_Processing;
begin begin
Supp_Index := In_Project.Supp_Language_Processing;
while Supp_Index /= No_Supp_Language_Index loop while Supp_Index /= No_Supp_Language_Index loop
Supp := In_Tree.Supp_Languages.Table (Supp_Index); Supp := In_Tree.Supp_Languages.Table (Supp_Index);
...@@ -811,7 +823,6 @@ package body Prj is ...@@ -811,7 +823,6 @@ package body Prj is
Language_Id := Name_Find; Language_Id := Name_Find;
Lang := In_Tree.First_Language; Lang := In_Tree.First_Language;
while Lang /= No_Language_Index loop while Lang /= No_Language_Index loop
if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
return return
...@@ -870,12 +881,11 @@ package body Prj is ...@@ -870,12 +881,11 @@ package body Prj is
Name_Buffer (1 .. Name_Len) := To_Lower (Name_Buffer (1 .. Name_Len)); Name_Buffer (1 .. Name_Len) := To_Lower (Name_Buffer (1 .. Name_Len));
Lang := Name_Find; Lang := Name_Find;
Suffix := In_Tree.Private_Part.Default_Naming.Spec_Suffix;
Found := False;
-- Look for an element of the spec sufix array indexed by the language -- Look for an element of the spec sufix array indexed by the language
-- name. If one is found, put the default value. -- name. If one is found, put the default value.
Suffix := In_Tree.Private_Part.Default_Naming.Spec_Suffix;
Found := False;
while Suffix /= No_Array_Element and then not Found loop while Suffix /= No_Array_Element and then not Found loop
Element := In_Tree.Array_Elements.Table (Suffix); Element := In_Tree.Array_Elements.Table (Suffix);
...@@ -911,12 +921,11 @@ package body Prj is ...@@ -911,12 +921,11 @@ package body Prj is
Array_Element_Table.Last (In_Tree.Array_Elements); Array_Element_Table.Last (In_Tree.Array_Elements);
end if; end if;
Suffix := In_Tree.Private_Part.Default_Naming.Body_Suffix;
Found := False;
-- Look for an element of the body sufix array indexed by the language -- Look for an element of the body sufix array indexed by the language
-- name. If one is found, put the default value. -- name. If one is found, put the default value.
Suffix := In_Tree.Private_Part.Default_Naming.Body_Suffix;
Found := False;
while Suffix /= No_Array_Element and then not Found loop while Suffix /= No_Array_Element and then not Found loop
Element := In_Tree.Array_Elements.Table (Suffix); Element := In_Tree.Array_Elements.Table (Suffix);
...@@ -1048,17 +1057,17 @@ package body Prj is ...@@ -1048,17 +1057,17 @@ package body Prj is
when others => when others =>
declare declare
Supp : Supp_Language; Supp : Supp_Language;
Supp_Index : Supp_Language_Index := In_Project.Supp_Languages; Supp_Index : Supp_Language_Index;
begin begin
Supp_Index := In_Project.Supp_Languages;
while Supp_Index /= No_Supp_Language_Index loop while Supp_Index /= No_Supp_Language_Index loop
Supp := In_Tree.Present_Languages.Table Supp := In_Tree.Present_Languages.Table (Supp_Index);
(Supp_Index);
if Supp.Index = Language then if Supp.Index = Language then
In_Tree.Present_Languages.Table In_Tree.Present_Languages.Table (Supp_Index).Present :=
(Supp_Index).Present := Present; Present;
return; return;
end if; end if;
...@@ -1069,8 +1078,8 @@ package body Prj is ...@@ -1069,8 +1078,8 @@ package body Prj is
Next => In_Project.Supp_Languages); Next => In_Project.Supp_Languages);
Present_Language_Table.Increment_Last Present_Language_Table.Increment_Last
(In_Tree.Present_Languages); (In_Tree.Present_Languages);
Supp_Index := Present_Language_Table.Last Supp_Index :=
(In_Tree.Present_Languages); Present_Language_Table.Last (In_Tree.Present_Languages);
In_Tree.Present_Languages.Table (Supp_Index) := In_Tree.Present_Languages.Table (Supp_Index) :=
Supp; Supp;
In_Project.Supp_Languages := Supp_Index; In_Project.Supp_Languages := Supp_Index;
...@@ -1095,7 +1104,7 @@ package body Prj is ...@@ -1095,7 +1104,7 @@ package body Prj is
when others => when others =>
declare declare
Supp : Supp_Language_Data; Supp : Supp_Language_Data;
Supp_Index : Supp_Language_Index; Supp_Index : Supp_Language_Index;
begin begin
...@@ -1140,18 +1149,16 @@ package body Prj is ...@@ -1140,18 +1149,16 @@ package body Prj is
when others => when others =>
declare declare
Supp : Supp_Suffix; Supp : Supp_Suffix;
Supp_Index : Supp_Language_Index := Supp_Index : Supp_Language_Index;
In_Project.Naming.Supp_Suffixes;
begin begin
Supp_Index := In_Project.Naming.Supp_Suffixes;
while Supp_Index /= No_Supp_Language_Index loop while Supp_Index /= No_Supp_Language_Index loop
Supp := In_Tree.Supp_Suffixes.Table Supp := In_Tree.Supp_Suffixes.Table (Supp_Index);
(Supp_Index);
if Supp.Index = For_Language then if Supp.Index = For_Language then
In_Tree.Supp_Suffixes.Table In_Tree.Supp_Suffixes.Table (Supp_Index).Suffix := Suffix;
(Supp_Index).Suffix := Suffix;
return; return;
end if; end if;
...@@ -1160,10 +1167,8 @@ package body Prj is ...@@ -1160,10 +1167,8 @@ package body Prj is
Supp := (Index => For_Language, Suffix => Suffix, Supp := (Index => For_Language, Suffix => Suffix,
Next => In_Project.Naming.Supp_Suffixes); Next => In_Project.Naming.Supp_Suffixes);
Supp_Suffix_Table.Increment_Last Supp_Suffix_Table.Increment_Last (In_Tree.Supp_Suffixes);
(In_Tree.Supp_Suffixes); Supp_Index := Supp_Suffix_Table.Last (In_Tree.Supp_Suffixes);
Supp_Index := Supp_Suffix_Table.Last
(In_Tree.Supp_Suffixes);
In_Tree.Supp_Suffixes.Table (Supp_Index) := Supp; In_Tree.Supp_Suffixes.Table (Supp_Index) := Supp;
In_Project.Naming.Supp_Suffixes := Supp_Index; In_Project.Naming.Supp_Suffixes := Supp_Index;
end; end;
...@@ -1224,6 +1229,14 @@ package body Prj is ...@@ -1224,6 +1229,14 @@ package body Prj is
procedure Set_Mode (New_Mode : Mode) is procedure Set_Mode (New_Mode : Mode) is
begin begin
Current_Mode := New_Mode; Current_Mode := New_Mode;
case New_Mode is
when Ada_Only =>
Default_Language_Is_Ada := True;
Must_Check_Configuration := False;
when Multi_Language =>
Default_Language_Is_Ada := False;
Must_Check_Configuration := True;
end case;
end Set_Mode; end Set_Mode;
--------------------- ---------------------
...@@ -1283,10 +1296,6 @@ package body Prj is ...@@ -1283,10 +1296,6 @@ package body Prj is
Naming : Naming_Data) return File_Name_Type Naming : Naming_Data) return File_Name_Type
is is
Language_Id : Name_Id; Language_Id : Name_Id;
Element_Id : Array_Element_Id;
Element : Array_Element;
Suffix : File_Name_Type := No_File;
Lang : Language_Index;
begin begin
Name_Len := 0; Name_Len := 0;
...@@ -1294,8 +1303,29 @@ package body Prj is ...@@ -1294,8 +1303,29 @@ package body Prj is
To_Lower (Name_Buffer (1 .. Name_Len)); To_Lower (Name_Buffer (1 .. Name_Len));
Language_Id := Name_Find; Language_Id := Name_Find;
Element_Id := Naming.Spec_Suffix; return
Spec_Suffix_Id_Of
(In_Tree => In_Tree,
Language_Id => Language_Id,
Naming => Naming);
end Spec_Suffix_Id_Of;
-----------------------
-- Spec_Suffix_Id_Of --
-----------------------
function Spec_Suffix_Id_Of
(In_Tree : Project_Tree_Ref;
Language_Id : Name_Id;
Naming : Naming_Data) return File_Name_Type
is
Element_Id : Array_Element_Id;
Element : Array_Element;
Suffix : File_Name_Type := No_File;
Lang : Language_Index;
begin
Element_Id := Naming.Spec_Suffix;
while Element_Id /= No_Array_Element loop while Element_Id /= No_Array_Element loop
Element := In_Tree.Array_Elements.Table (Element_Id); Element := In_Tree.Array_Elements.Table (Element_Id);
...@@ -1308,7 +1338,6 @@ package body Prj is ...@@ -1308,7 +1338,6 @@ package body Prj is
if Current_Mode = Multi_Language then if Current_Mode = Multi_Language then
Lang := In_Tree.First_Language; Lang := In_Tree.First_Language;
while Lang /= No_Language_Index loop while Lang /= No_Language_Index loop
if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
Suffix := Suffix :=
...@@ -1346,7 +1375,6 @@ package body Prj is ...@@ -1346,7 +1375,6 @@ package body Prj is
Language_Id := Name_Find; Language_Id := Name_Find;
Element_Id := Naming.Spec_Suffix; Element_Id := Naming.Spec_Suffix;
while Element_Id /= No_Array_Element loop while Element_Id /= No_Array_Element loop
Element := In_Tree.Array_Elements.Table (Element_Id); Element := In_Tree.Array_Elements.Table (Element_Id);
...@@ -1359,7 +1387,6 @@ package body Prj is ...@@ -1359,7 +1387,6 @@ package body Prj is
if Current_Mode = Multi_Language then if Current_Mode = Multi_Language then
Lang := In_Tree.First_Language; Lang := In_Tree.First_Language;
while Lang /= No_Language_Index loop while Lang /= No_Language_Index loop
if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
Suffix := Suffix :=
...@@ -1416,11 +1443,11 @@ package body Prj is ...@@ -1416,11 +1443,11 @@ package body Prj is
when others => when others =>
declare declare
Supp : Supp_Suffix; Supp : Supp_Suffix;
Supp_Index : Supp_Language_Index := Supp_Index : Supp_Language_Index;
In_Project.Naming.Supp_Suffixes;
begin begin
Supp_Index := In_Project.Naming.Supp_Suffixes;
while Supp_Index /= No_Supp_Language_Index loop while Supp_Index /= No_Supp_Language_Index loop
Supp := In_Tree.Supp_Suffixes.Table (Supp_Index); Supp := In_Tree.Supp_Suffixes.Table (Supp_Index);
......
gcc/ada/prj.ads
...@@ -62,6 +62,17 @@ package Prj is ...@@ -62,6 +62,17 @@ package Prj is
procedure Set_Mode (New_Mode : Mode); procedure Set_Mode (New_Mode : Mode);
pragma Inline (Set_Mode); pragma Inline (Set_Mode);
Default_Language_Is_Ada : Boolean := True;
-- If no language was defined in the project or the configuration file, it
-- is an error, unless this variable is True, in which case it defaults to
-- Ada. Calling Set_Mode will reset this variable, default is for Ada_Only.
Must_Check_Configuration : Boolean := False;
-- Whether the contents of the configuration file must be checked. This is
-- in general only needed by gprbuild itself, since other applications can
-- ignore such errors when they don't need to build directly. Calling
-- Set_Mode will reset this variable, default is for Ada_Only.
function In_Configuration return Boolean; function In_Configuration return Boolean;
pragma Inline (In_Configuration); pragma Inline (In_Configuration);
...@@ -74,8 +85,8 @@ package Prj is ...@@ -74,8 +85,8 @@ package Prj is
type Project_Tree_Data; type Project_Tree_Data;
type Project_Tree_Ref is access all Project_Tree_Data; type Project_Tree_Ref is access all Project_Tree_Data;
-- Reference to a project tree. -- Reference to a project tree. Several project trees may exist in memory
-- Several project trees may exist in memory at the same time. -- at the same time.
No_Project_Tree : constant Project_Tree_Ref; No_Project_Tree : constant Project_Tree_Ref;
...@@ -260,24 +271,33 @@ package Prj is ...@@ -260,24 +271,33 @@ package Prj is
-- The table that contains all packages -- The table that contains all packages
type Language_Index is new Nat; type Language_Index is new Nat;
-- Index of language data
No_Language_Index : constant Language_Index := 0; No_Language_Index : constant Language_Index := 0;
-- Constant indicating that there is no language data
procedure Display_Language_Name procedure Display_Language_Name
(In_Tree : Project_Tree_Ref; (In_Tree : Project_Tree_Ref;
Language : Language_Index); Language : Language_Index);
-- Output the name of a language
type Header_Num is range 0 .. 2047; type Header_Num is range 0 .. 6150;
-- Size for hash table below. The upper bound is an arbitrary value, the
function Hash is new System.HTable.Hash (Header_Num => Header_Num); -- value here was chosen after testing to determine a good compromise
-- between speed of access and memory usage.
function Hash (Name : Name_Id) return Header_Num; function Hash (Name : Name_Id) return Header_Num;
function Hash (Name : File_Name_Type) return Header_Num; function Hash (Name : File_Name_Type) return Header_Num;
function Hash (Name : Path_Name_Type) return Header_Num; function Hash (Name : Path_Name_Type) return Header_Num;
-- Used for computing hash values for names put into above hash table
type Language_Kind is (File_Based, Unit_Based); type Language_Kind is (File_Based, Unit_Based);
-- Type for the kind of language. All languages are file based, except Ada
-- which is unit based.
type Dependency_File_Kind is (None, Makefile, ALI_File); type Dependency_File_Kind is (None, Makefile, ALI_File);
-- Type of dependency to be checked: no dependency file, Makefile fragment
-- or ALI file (for Ada).
Makefile_Dependency_Suffix : constant String := ".d"; Makefile_Dependency_Suffix : constant String := ".d";
ALI_Dependency_Suffix : constant String := ".ali"; ALI_Dependency_Suffix : constant String := ".ali";
...@@ -345,8 +365,6 @@ package Prj is ...@@ -345,8 +365,6 @@ package Prj is
No_Source : constant Source_Id := 0; No_Source : constant Source_Id := 0;
-- All the fields in the below record should be commented ???
type Language_Config is record type Language_Config is record
Kind : Language_Kind := File_Based; Kind : Language_Kind := File_Based;
-- Kind of language. All languages are file based, except Ada which is -- Kind of language. All languages are file based, except Ada which is
...@@ -370,47 +388,104 @@ package Prj is ...@@ -370,47 +388,104 @@ package Prj is
-- shared libraries. Specified in the configuration. When not specified, -- shared libraries. Specified in the configuration. When not specified,
-- there is no need for such switch. -- there is no need for such switch.
Runtime_Library_Dir : Name_Id := No_Name; Runtime_Library_Dir : Name_Id := No_Name;
-- Path name of the runtime library directory, if any
Mapping_File_Switches : Name_List_Index := No_Name_List; Mapping_File_Switches : Name_List_Index := No_Name_List;
-- The option(s) to provide a mapping file to the compiler. Specified in -- The option(s) to provide a mapping file to the compiler. Specified in
-- the configuration. When not ??? -- the configuration. When value is No_Name_List, there is no mapping
-- file.
Mapping_Spec_Suffix : File_Name_Type := No_File;
-- Placeholder representing the spec suffix in a mapping file
Mapping_Body_Suffix : File_Name_Type := No_File;
-- Placeholder representing the body suffix in a mapping file
Config_File_Switches : Name_List_Index := No_Name_List;
-- The option(s) to provide a config file to the compiler. Specified in
-- the configuration. When value is No_Name_List, there is no config
-- file.
Dependency_Kind : Dependency_File_Kind := None;
-- The kind of dependency to be checked: none, Makefile fragment or
-- ALI file (for Ada).
Dependency_Option : Name_List_Index := No_Name_List;
-- The option(s) to be used to create the dependency file. When value is
-- No_Name_List, there is not such option(s).
Compute_Dependency : Name_List_Index := No_Name_List;
-- Hold the value of attribute Dependency_Driver, if declared for the
-- language.
Mapping_Spec_Suffix : File_Name_Type := No_File; Include_Option : Name_List_Index := No_Name_List;
Mapping_Body_Suffix : File_Name_Type := No_File; -- Hold the value of attribute Include_Switches, if declared for the
Config_File_Switches : Name_List_Index := No_Name_List; -- language.
Dependency_Kind : Dependency_File_Kind := None;
Dependency_Option : Name_List_Index := No_Name_List;
Compute_Dependency : Name_List_Index := No_Name_List;
Include_Option : Name_List_Index := No_Name_List;
Include_Path : Name_Id := No_Name; Include_Path : Name_Id := No_Name;
-- Name of an environment variable -- Name of environment variable declared by attribute Include_Path for
-- the language.
Include_Path_File : Name_Id := No_Name; Include_Path_File : Name_Id := No_Name;
-- Name of an environment variable -- Name of environment variable declared by attribute Include_Path_File
-- for the language.
Objects_Path : Name_Id := No_Name; Objects_Path : Name_Id := No_Name;
-- Name of an environment variable -- Name of environment variable declared by attribute Objects_Path for
-- the language.
Objects_Path_File : Name_Id := No_Name; Objects_Path_File : Name_Id := No_Name;
-- Name of an environment variable -- Name of environment variable declared by attribute Objects_Path_File
-- for the language.
Config_Body : Name_Id := No_Name;
-- The template for a pragma Source_File_Name(_Project) for a specific
-- file name of a body.
Config_Body : Name_Id := No_Name;
Config_Spec : Name_Id := No_Name; Config_Spec : Name_Id := No_Name;
-- The template for a pragma Source_File_Name(_Project) for a specific
-- file name of a spec.
Config_Body_Pattern : Name_Id := No_Name; Config_Body_Pattern : Name_Id := No_Name;
-- The template for a pragma Source_File_Name(_Project) for a naming
-- body pattern.
Config_Spec_Pattern : Name_Id := No_Name; Config_Spec_Pattern : Name_Id := No_Name;
Config_File_Unique : Boolean := False; -- The template for a pragma Source_File_Name(_Project) for a naming
Runtime_Project : Path_Name_Type := No_Path; -- spec pattern.
Binder_Driver : File_Name_Type := No_File;
Binder_Driver_Path : Path_Name_Type := No_Path; Config_File_Unique : Boolean := False;
Binder_Required_Switches : Name_List_Index := No_Name_List; -- Indicate if the config file specified to the compiler needs to be
Binder_Prefix : Name_Id := No_Name; -- unique. If it is unique, then all config files are concatenated into
Toolchain_Version : Name_Id := No_Name; -- a temp config file.
Toolchain_Description : Name_Id := No_Name;
PIC_Option : Name_Id := No_Name; Binder_Driver : File_Name_Type := No_File;
Objects_Generated : Boolean := True; -- The name of the binder driver for the language, if any
Binder_Driver_Path : Path_Name_Type := No_Path;
-- The path name of the binder driver
Binder_Required_Switches : Name_List_Index := No_Name_List;
-- Hold the value of attribute Binder'Required_Switches for the language
Binder_Prefix : Name_Id := No_Name;
-- Hold the value of attribute Binder'Prefixthe language
Toolchain_Version : Name_Id := No_Name;
-- Hold the value of attribute Toolchain_Version for the language
Toolchain_Description : Name_Id := No_Name;
-- Hold the value of attribute Toolchain_Description for the language
PIC_Option : Name_Id := No_Name;
-- Hold the value of attribute Compiler'PIC_Option for the language
Objects_Generated : Boolean := True;
-- Indicates if objects are generated for the language
end record; end record;
-- Record describing the configuration of a language
No_Language_Config : constant Language_Config := No_Language_Config : constant Language_Config :=
(Kind => File_Based, (Kind => File_Based,
...@@ -437,7 +512,6 @@ package Prj is ...@@ -437,7 +512,6 @@ package Prj is
Config_Body_Pattern => No_Name, Config_Body_Pattern => No_Name,
Config_Spec_Pattern => No_Name, Config_Spec_Pattern => No_Name,
Config_File_Unique => False, Config_File_Unique => False,
Runtime_Project => No_Path,
Binder_Driver => No_File, Binder_Driver => No_File,
Binder_Driver_Path => No_Path, Binder_Driver_Path => No_Path,
Binder_Required_Switches => No_Name_List, Binder_Required_Switches => No_Name_List,
...@@ -493,30 +567,78 @@ package Prj is ...@@ -493,30 +567,78 @@ package Prj is
type Source_Kind is (Spec, Impl, Sep); type Source_Kind is (Spec, Impl, Sep);
-- Following record needs full comments on every field ???
type Source_Data is record type Source_Data is record
Project : Project_Id := No_Project; Project : Project_Id := No_Project;
-- Project of the source
Language_Name : Name_Id := No_Name; Language_Name : Name_Id := No_Name;
-- Name of the language of the source
Language : Language_Index := No_Language_Index; Language : Language_Index := No_Language_Index;
-- Index of the language
Lang_Kind : Language_Kind := File_Based;
-- Kind of the language
Alternate_Languages : Alternate_Language_Id := No_Alternate_Language; Alternate_Languages : Alternate_Language_Id := No_Alternate_Language;
-- List of languages a header file may also be, in addition of
-- language Language_Name.
Kind : Source_Kind := Spec; Kind : Source_Kind := Spec;
Dependency : Dependency_File_Kind := Makefile; -- Kind of the source: spec, body or subunit
Dependency : Dependency_File_Kind := None;
-- Kind of dependency: none, Makefile fragment or ALI file
Other_Part : Source_Id := No_Source; Other_Part : Source_Id := No_Source;
-- Source ID for the other part, if any: for a spec, indicates its body;
-- for a body, indicates its spec.
Unit : Name_Id := No_Name; Unit : Name_Id := No_Name;
-- Name of the unit, if language is unit based
Index : Int := 0; Index : Int := 0;
-- Index of the source in a multi unit source file
Locally_Removed : Boolean := False; Locally_Removed : Boolean := False;
-- True if the source has been "excluded"
Get_Object : Boolean := False;
-- Indicates that the object of the source should be put in the global
-- archive. This is for Ada, when only the closure of a main needs to
-- be compiled/recompiled.
Replaced_By : Source_Id := No_Source; Replaced_By : Source_Id := No_Source;
File : File_Name_Type := No_File; File : File_Name_Type := No_File;
-- Canonical file name of the source
Display_File : File_Name_Type := No_File; Display_File : File_Name_Type := No_File;
-- File name of the source, for display purposes
Path : Path_Name_Type := No_Path; Path : Path_Name_Type := No_Path;
-- Canonical path name of the source
Display_Path : Path_Name_Type := No_Path; Display_Path : Path_Name_Type := No_Path;
-- Path name of the source, for display purposes
Source_TS : Time_Stamp_Type := Empty_Time_Stamp; Source_TS : Time_Stamp_Type := Empty_Time_Stamp;
-- Time stamp of the source file
Object_Project : Project_Id := No_Project; Object_Project : Project_Id := No_Project;
-- Project where the object file is
Object_Exists : Boolean := True; Object_Exists : Boolean := True;
-- True if an object file exists
Object : File_Name_Type := No_File; Object : File_Name_Type := No_File;
-- File name of the object file
Current_Object_Path : Path_Name_Type := No_Path; Current_Object_Path : Path_Name_Type := No_Path;
-- Object path of an existing object file
Object_Path : Path_Name_Type := No_Path; Object_Path : Path_Name_Type := No_Path;
-- Object path of the real object file
Object_TS : Time_Stamp_Type := Empty_Time_Stamp; Object_TS : Time_Stamp_Type := Empty_Time_Stamp;
-- Object file time stamp -- Object file time stamp
...@@ -525,33 +647,49 @@ package Prj is ...@@ -525,33 +647,49 @@ package Prj is
-- Dependency file simple name -- Dependency file simple name
Current_Dep_Path : Path_Name_Type := No_Path; Current_Dep_Path : Path_Name_Type := No_Path;
-- Path name of an existing dependency file
Dep_Path : Path_Name_Type := No_Path; Dep_Path : Path_Name_Type := No_Path;
-- Dependency full path name -- Path name of the real dependency file
Dep_TS : Time_Stamp_Type := Empty_Time_Stamp; Dep_TS : Time_Stamp_Type := Empty_Time_Stamp;
-- Dependency file time stamp -- Dependency file time stamp
Switches : File_Name_Type := No_File; Switches : File_Name_Type := No_File;
Switches_Path : Path_Name_Type := No_Path; -- File name of the switches file
Switches_TS : Time_Stamp_Type := Empty_Time_Stamp;
Naming_Exception : Boolean := False; Switches_Path : Path_Name_Type := No_Path;
Next_In_Sources : Source_Id := No_Source; -- Path name of the switches file
Next_In_Project : Source_Id := No_Source;
Next_In_Lang : Source_Id := No_Source; Switches_TS : Time_Stamp_Type := Empty_Time_Stamp;
-- Switches file time stamp
Naming_Exception : Boolean := False;
-- True if the source has an exceptional name
Next_In_Sources : Source_Id := No_Source;
-- Link to another source in the project tree
Next_In_Project : Source_Id := No_Source;
-- Link to another source in the project
Next_In_Lang : Source_Id := No_Source;
-- Link to another source of the same language
end record; end record;
No_Source_Data : constant Source_Data := No_Source_Data : constant Source_Data :=
(Project => No_Project, (Project => No_Project,
Language_Name => No_Name, Language_Name => No_Name,
Language => No_Language_Index, Language => No_Language_Index,
Lang_Kind => File_Based,
Alternate_Languages => No_Alternate_Language, Alternate_Languages => No_Alternate_Language,
Kind => Spec, Kind => Spec,
Dependency => Makefile, Dependency => None,
Other_Part => No_Source, Other_Part => No_Source,
Unit => No_Name, Unit => No_Name,
Index => 0, Index => 0,
Locally_Removed => False, Locally_Removed => False,
Get_Object => False,
Replaced_By => No_Source, Replaced_By => No_Source,
File => No_File, File => No_File,
Display_File => No_File, Display_File => No_File,
...@@ -855,6 +993,11 @@ package Prj is ...@@ -855,6 +993,11 @@ package Prj is
Language : String; Language : String;
Naming : Naming_Data) return File_Name_Type; Naming : Naming_Data) return File_Name_Type;
function Spec_Suffix_Id_Of
(In_Tree : Project_Tree_Ref;
Language_Id : Name_Id;
Naming : Naming_Data) return File_Name_Type;
procedure Set_Spec_Suffix procedure Set_Spec_Suffix
(In_Tree : Project_Tree_Ref; (In_Tree : Project_Tree_Ref;
Language : String; Language : String;
...@@ -866,6 +1009,11 @@ package Prj is ...@@ -866,6 +1009,11 @@ package Prj is
Language : String; Language : String;
Naming : Naming_Data) return File_Name_Type; Naming : Naming_Data) return File_Name_Type;
function Body_Suffix_Id_Of
(In_Tree : Project_Tree_Ref;
Language_Id : Name_Id;
Naming : Naming_Data) return File_Name_Type;
function Body_Suffix_Of function Body_Suffix_Of
(In_Tree : Project_Tree_Ref; (In_Tree : Project_Tree_Ref;
Language : String; Language : String;
...@@ -1034,10 +1182,10 @@ package Prj is ...@@ -1034,10 +1182,10 @@ package Prj is
-- True if the project is externally built. In such case, the Project -- True if the project is externally built. In such case, the Project
-- Manager will not modify anything in this project. -- Manager will not modify anything in this project.
Languages : Name_List_Index := No_Name_List; Languages : Name_List_Index := No_Name_List;
-- The list of languages of the sources of this project -- The list of languages of the sources of this project
Config : Project_Configuration; Config : Project_Configuration;
First_Referred_By : Project_Id := No_Project; First_Referred_By : Project_Id := No_Project;
-- The project, if any, that was the first to be known as importing or -- The project, if any, that was the first to be known as importing or
...@@ -1141,7 +1289,7 @@ package Prj is ...@@ -1141,7 +1289,7 @@ package Prj is
Ada_Sources : String_List_Id := Nil_String; Ada_Sources : String_List_Id := Nil_String;
-- The list of all the Ada source file names (gnatmake only). -- The list of all the Ada source file names (gnatmake only).
Sources : String_List_Id := Nil_String; Sources : String_List_Id := Nil_String;
-- Identical to Ada_Sources. For upward compatibility of GPS. -- Identical to Ada_Sources. For upward compatibility of GPS.
First_Source : Source_Id := No_Source; First_Source : Source_Id := No_Source;
...@@ -1207,7 +1355,7 @@ package Prj is ...@@ -1207,7 +1355,7 @@ package Prj is
-- The naming scheme of this project file -- The naming scheme of this project file
First_Language_Processing : Language_Index := No_Language_Index; First_Language_Processing : Language_Index := No_Language_Index;
-- Comment needed ??? -- First index of the language data in the project
Decl : Declarations := No_Declarations; Decl : Declarations := No_Declarations;
-- The declarations (variables, attributes and packages) of this project -- The declarations (variables, attributes and packages) of this project
...@@ -1229,8 +1377,9 @@ package Prj is ...@@ -1229,8 +1377,9 @@ package Prj is
-- use this field directly outside of the compiler, use -- use this field directly outside of the compiler, use
-- Prj.Env.Ada_Objects_Path instead. -- Prj.Env.Ada_Objects_Path instead.
Objects_Path : String_Access := null; Objects_Path : String_Access := null;
-- ??? -- The cached value of the object dir path, used during the binding
-- phase of gprbuild.
Objects_Path_File_With_Libs : Path_Name_Type := No_Path; Objects_Path_File_With_Libs : Path_Name_Type := No_Path;
-- The cached value of the object path temp file (including library -- The cached value of the object path temp file (including library
...@@ -1247,13 +1396,13 @@ package Prj is ...@@ -1247,13 +1396,13 @@ package Prj is
-- An indication that the configuration pragmas file is a temporary file -- An indication that the configuration pragmas file is a temporary file
-- that must be deleted at the end. -- that must be deleted at the end.
Linker_Name : File_Name_Type := No_File; Linker_Name : File_Name_Type := No_File;
-- Value of attribute Language_Processing'Linker in the project file -- Value of attribute Language_Processing'Linker in the project file
Linker_Path : Path_Name_Type := No_Path; Linker_Path : Path_Name_Type := No_Path;
-- Path of linker when attribute Language_Processing'Linker is specified -- Path of linker when attribute Language_Processing'Linker is specified
Minimum_Linker_Options : Name_List_Index := No_Name_List; Minimum_Linker_Options : Name_List_Index := No_Name_List;
-- List of options specified in attribute -- List of options specified in attribute
-- Language_Processing'Minimum_Linker_Options. -- Language_Processing'Minimum_Linker_Options.
...@@ -1280,19 +1429,32 @@ package Prj is ...@@ -1280,19 +1429,32 @@ package Prj is
-- True if there are comments in the project sources that cannot be kept -- True if there are comments in the project sources that cannot be kept
-- in the project tree. -- in the project tree.
-- For gprmake ------------------
-- For gprmake --
------------------
Langs : Languages_In_Project := No_Languages; Langs : Languages_In_Project := No_Languages;
Supp_Languages : Supp_Language_Index := No_Supp_Language_Index; Supp_Languages : Supp_Language_Index := No_Supp_Language_Index;
-- Indicate the different languages of the source of this project -- Indicate the different languages of the source of this project
Ada_Sources_Present : Boolean := True; Ada_Sources_Present : Boolean := True;
Other_Sources_Present : Boolean := True; -- True if there are Ada sources in the project
First_Other_Source : Other_Source_Id := No_Other_Source;
Last_Other_Source : Other_Source_Id := No_Other_Source; Other_Sources_Present : Boolean := True;
-- True if there are sources from languages other than Ada in the
-- project.
First_Other_Source : Other_Source_Id := No_Other_Source;
-- First source of a language other than Ada
Last_Other_Source : Other_Source_Id := No_Other_Source;
-- Last source of a language other than Ada
First_Lang_Processing : First_Language_Processing_Data := First_Lang_Processing : First_Language_Processing_Data :=
Default_First_Language_Processing_Data; Default_First_Language_Processing_Data;
Supp_Language_Processing : Supp_Language_Index := No_Supp_Language_Index; Supp_Language_Processing : Supp_Language_Index :=
No_Supp_Language_Index;
-- Language configurations
end record; end record;
function Empty_Project (Tree : Project_Tree_Ref) return Project_Data; function Empty_Project (Tree : Project_Tree_Ref) return Project_Data;
...@@ -1307,7 +1469,9 @@ package Prj is ...@@ -1307,7 +1469,9 @@ package Prj is
function Is_A_Language function Is_A_Language
(Tree : Project_Tree_Ref; (Tree : Project_Tree_Ref;
Data : Project_Data; Data : Project_Data;
Language_Name : String) return Boolean; Language_Name : Name_Id) return Boolean;
-- Whether Language_Name is one of the languages used for the project.
-- Language_Name must be lower cased.
function There_Are_Ada_Sources function There_Are_Ada_Sources
(In_Tree : Project_Tree_Ref; (In_Tree : Project_Tree_Ref;
...@@ -1329,12 +1493,12 @@ package Prj is ...@@ -1329,12 +1493,12 @@ package Prj is
type File_Name_Data is record type File_Name_Data is record
Name : File_Name_Type := No_File; Name : File_Name_Type := No_File;
Index : Int := 0; Index : Int := 0;
Display_Name : File_Name_Type := No_File; Display_Name : File_Name_Type := No_File;
Path : Path_Name_Type := No_Path; Path : Path_Name_Type := No_Path;
Display_Path : Path_Name_Type := No_Path; Display_Path : Path_Name_Type := No_Path;
Project : Project_Id := No_Project; Project : Project_Id := No_Project;
Needs_Pragma : Boolean := False; Needs_Pragma : Boolean := False;
end record; end record;
-- File and Path name of a spec or body -- File and Path name of a spec or body
...@@ -1389,29 +1553,29 @@ package Prj is ...@@ -1389,29 +1553,29 @@ package Prj is
record record
-- Languages and sources of the project -- Languages and sources of the project
First_Language : Language_Index := No_Language_Index; First_Language : Language_Index := No_Language_Index;
-- --
First_Source : Source_Id := No_Source; First_Source : Source_Id := No_Source;
-- --
-- Tables -- Tables
Languages_Data : Language_Data_Table.Instance; Languages_Data : Language_Data_Table.Instance;
Name_Lists : Name_List_Table.Instance; Name_Lists : Name_List_Table.Instance;
String_Elements : String_Element_Table.Instance; String_Elements : String_Element_Table.Instance;
Variable_Elements : Variable_Element_Table.Instance; Variable_Elements : Variable_Element_Table.Instance;
Array_Elements : Array_Element_Table.Instance; Array_Elements : Array_Element_Table.Instance;
Arrays : Array_Table.Instance; Arrays : Array_Table.Instance;
Packages : Package_Table.Instance; Packages : Package_Table.Instance;
Project_Lists : Project_List_Table.Instance; Project_Lists : Project_List_Table.Instance;
Projects : Project_Table.Instance; Projects : Project_Table.Instance;
Sources : Source_Data_Table.Instance; Sources : Source_Data_Table.Instance;
Alt_Langs : Alternate_Language_Table.Instance; Alt_Langs : Alternate_Language_Table.Instance;
Units : Unit_Table.Instance; Units : Unit_Table.Instance;
Units_HT : Units_Htable.Instance; Units_HT : Units_Htable.Instance;
Files_HT : Files_Htable.Instance; Files_HT : Files_Htable.Instance;
Source_Paths_HT : Source_Paths_Htable.Instance; Source_Paths_HT : Source_Paths_Htable.Instance;
-- For gprmake: -- For gprmake:
...@@ -1422,7 +1586,7 @@ package Prj is ...@@ -1422,7 +1586,7 @@ package Prj is
-- Private part -- Private part
Private_Part : Private_Project_Tree_Data; Private_Part : Private_Project_Tree_Data;
end record; end record;
-- Data for a project tree -- Data for a project tree
...@@ -1565,10 +1729,10 @@ private ...@@ -1565,10 +1729,10 @@ private
Ignored : constant Variable_Kind := Single; Ignored : constant Variable_Kind := Single;
Nil_Variable_Value : constant Variable_Value := Nil_Variable_Value : constant Variable_Value :=
(Project => No_Project, (Project => No_Project,
Kind => Undefined, Kind => Undefined,
Location => No_Location, Location => No_Location,
Default => False); Default => False);
Virtual_Prefix : constant String := "v$"; Virtual_Prefix : constant String := "v$";
-- The prefix for virtual extending projects. Because of the '$', which is -- The prefix for virtual extending projects. Because of the '$', which is
...@@ -1592,7 +1756,7 @@ private ...@@ -1592,7 +1756,7 @@ private
Table_Low_Bound => 1, Table_Low_Bound => 1,
Table_Initial => 5, Table_Initial => 5,
Table_Increment => 100); Table_Increment => 100);
-- Comment ??? -- Table storing the naming data for gnatmake/gprmake
package Path_File_Table is new GNAT.Dynamic_Tables package Path_File_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Path_Name_Type, (Table_Component_Type => Path_Name_Type,
......
gcc/ada/switch-m.adb
...@@ -584,7 +584,7 @@ package body Switch.M is ...@@ -584,7 +584,7 @@ package body Switch.M is
Bad_Switch (Switch_Chars); Bad_Switch (Switch_Chars);
else else
Follow_Links := True; Follow_Links_For_Files := True;
end if; end if;
-- Processing for eS switch -- Processing for eS switch
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment