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
"lVmain#" &
"LVlanguages#" &
"SVmain_language#" &
"Laroots#" &
"Lbroots#" &
"SVexternally_built#" &
-- Directories
......@@ -178,7 +178,7 @@ package body Prj.Attr is
-- Configuration - Dependencies
"Ladependency_switches#" &
"Lacompute_dependency#" &
"Ladependency_driver#" &
-- Configuration - Search paths
......
gcc/ada/prj-dect.adb
......@@ -790,9 +790,8 @@ package body Prj.Dect is
Declarations := Empty_Node;
loop
-- We are always positioned at the token that precedes
-- the first token of the declarative element.
-- Scan past it
-- We are always positioned at the token that precedes the first
-- token of the declarative element. Scan past it.
Scan (In_Tree);
......@@ -802,8 +801,38 @@ package body Prj.Dect is
when Tok_Identifier =>
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;
Parse_Variable_Declaration
......
gcc/ada/prj-env.adb
......@@ -1331,21 +1331,22 @@ package body Prj.Env is
while Source /= No_Source loop
Src_Data := In_Tree.Sources.Table (Source);
if Src_Data.Language_Name = Language and then
(not Src_Data.Locally_Removed) and then
Src_Data.Replaced_By = No_Source and then
Src_Data.Path /= No_Path
if Src_Data.Language_Name = Language
and then not Src_Data.Locally_Removed
and then Src_Data.Replaced_By = No_Source
and then Src_Data.Path /= No_Path
then
if Src_Data.Unit /= No_Name then
Get_Name_String (Src_Data.Unit);
if Src_Data.Kind = Spec then
Suffix := In_Tree.Languages_Data.Table
(Src_Data.Language).Config.Mapping_Spec_Suffix;
Suffix :=
In_Tree.Languages_Data.Table
(Src_Data.Language).Config.Mapping_Spec_Suffix;
else
Suffix := In_Tree.Languages_Data.Table
(Src_Data.Language).Config.Mapping_Body_Suffix;
Suffix :=
In_Tree.Languages_Data.Table
(Src_Data.Language).Config.Mapping_Body_Suffix;
end if;
if Suffix /= No_File then
......@@ -1956,6 +1957,8 @@ package body Prj.Env is
procedure Initialize is
begin
Fill_Mapping_File := True;
Current_Source_Path_File := No_Path;
Current_Object_Path_File := No_Path;
end Initialize;
------------------------------------
......@@ -2323,10 +2326,10 @@ package body Prj.Env is
-- except if we don't include library project and this
-- is a library project.
if (Data.Library and then Including_Libraries)
if (Data.Library and Including_Libraries)
or else
(Data.Object_Directory /= No_Path
and then
and then
(not Including_Libraries or else not Data.Library))
then
-- For a library project, add the library ALI
......
gcc/ada/prj-ext.adb
......@@ -66,7 +66,6 @@ package body Prj.Ext is
-- first for external reference in this table, before checking the
-- environment. Htable is emptied (reset) by procedure Reset.
---------
package Search_Directories is new Table.Table
(Table_Component_Type => Name_Id,
Table_Index_Type => Natural,
......@@ -76,6 +75,7 @@ package body Prj.Ext is
Table_Name => "Prj.Ext.Search_Directories");
-- The table for the directories specified with -aP switches
---------
-- Add --
---------
......@@ -142,20 +142,18 @@ package body Prj.Ext is
Prj_Path : String_Access := Gpr_Prj_Path;
begin
if Get_Mode = Ada_Only then
if Gpr_Prj_Path.all /= "" then
-- Warn if both environment variables are defined
if Gpr_Prj_Path.all /= "" then
if Ada_Prj_Path.all /= "" then
Write_Line
("Warning: ADA_PROJECT_PATH is not taken into account");
Write_Line (" when GPR_PROJECT_PATH is defined");
end if;
-- In Ada only mode, warn if both environment variables are defined
else
Prj_Path := Ada_Prj_Path;
if Get_Mode = Ada_Only and then Ada_Prj_Path.all /= "" then
Write_Line
("Warning: ADA_PROJECT_PATH is not taken into account");
Write_Line (" when GPR_PROJECT_PATH is defined");
end if;
else
Prj_Path := Ada_Prj_Path;
end if;
-- The current directory is always first
......
gcc/ada/prj-makr.adb
......@@ -741,6 +741,7 @@ package body Prj.Makr is
Project_File_Name => Output_Name (1 .. Output_Name_Last),
Always_Errout_Finalize => False,
Store_Comments => True,
Current_Directory => Get_Current_Dir,
Packages_To_Check => Packages_To_Check_By_Gnatname);
-- 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
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
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 library attributes, including the library directory if any
......@@ -53,10 +53,7 @@ private package Prj.Nmsc is
-- If Report_Error is null , use the standard error reporting mechanism
-- (Errout). Otherwise, report errors using Report_Error.
--
-- If Follow_Links is False, it is assumed that the project doesn't contain
-- 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.
-- Current_Dir is for optimization purposes only, avoiding system calls.
--
-- When_No_Sources indicates what should be done when no sources of a
-- language are found in a project where this language is declared.
......
gcc/ada/prj-pars.adb
......@@ -24,8 +24,8 @@
------------------------------------------------------------------------------
with Ada.Exceptions; use Ada.Exceptions;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with Opt;
with Output; use Output;
with Prj.Err; use Prj.Err;
with Prj.Part;
......@@ -52,6 +52,7 @@ package body Prj.Pars is
Project_Node : Project_Node_Id := Empty_Node;
The_Project : Project_Id := No_Project;
Success : Boolean := True;
Current_Dir : constant String := Get_Current_Dir;
begin
Prj.Tree.Initialize (Project_Node_Tree);
......@@ -64,7 +65,8 @@ package body Prj.Pars is
Project => Project_Node,
Project_File_Name => Project_File_Name,
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
......@@ -76,9 +78,9 @@ package body Prj.Pars is
From_Project_Node => Project_Node,
From_Project_Node_Tree => Project_Node_Tree,
Report_Error => null,
Follow_Links => Opt.Follow_Links,
When_No_Sources => When_No_Sources,
Reset_Tree => Reset_Tree);
Reset_Tree => Reset_Tree,
Current_Dir => Current_Dir);
Prj.Err.Finalize;
if not Success then
......
gcc/ada/prj-part.adb
......@@ -39,8 +39,6 @@ with Table;
with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Exceptions; use Ada.Exceptions;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with System.HTable; use System.HTable;
package body Prj.Part is
......@@ -48,7 +46,7 @@ package body Prj.Part is
Buffer : String_Access;
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 --
......@@ -116,6 +114,15 @@ package body Prj.Part is
-- need to have a virtual extending project, to avoid processing the same
-- 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
(For_Project : Project_Node_Id;
Main_Project : Project_Node_Id;
......@@ -153,7 +160,8 @@ package body Prj.Part is
From_Extended : Extension_Origin;
In_Limited : Boolean;
Packages_To_Check : String_List_Access;
Depth : Natural);
Depth : Natural;
Current_Dir : String);
-- 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
......@@ -327,8 +335,7 @@ package body Prj.Part is
----------------------------
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);
......@@ -366,7 +373,6 @@ package body Prj.Part is
(Proj : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
Potentially_Virtual : Boolean)
is
Declaration : Project_Node_Id := Empty_Node;
-- Node for the project declaration of Proj
......@@ -436,10 +442,9 @@ package body Prj.Part is
Project_File_Name : String;
Always_Errout_Finalize : Boolean;
Packages_To_Check : String_List_Access := All_Packages;
Store_Comments : Boolean := False)
Store_Comments : Boolean := False;
Current_Directory : String := "")
is
Current_Directory : constant String := Get_Current_Dir;
Dummy : Boolean;
pragma Warnings (Off, Dummy);
......@@ -454,6 +459,8 @@ package body Prj.Part is
Project := Empty_Node;
Projects_Paths.Reset;
if Current_Verbosity >= Medium then
Write_Str ("GPR_PROJECT_PATH=""");
Write_Str (Project_Path);
......@@ -476,7 +483,9 @@ package body Prj.Part is
if Path_Name = "" then
Prj.Com.Fail
("project file """, Project_File_Name, """ not found");
("project file """,
Project_File_Name,
""" not found in " & Project_Path);
Project := Empty_Node;
return;
end if;
......@@ -490,7 +499,8 @@ package body Prj.Part is
From_Extended => None,
In_Limited => False,
Packages_To_Check => Packages_To_Check,
Depth => 0);
Depth => 0,
Current_Dir => Current_Directory);
-- If Project is an extending-all project, create the eventual
-- virtual extending projects and check that there are no illegally
......@@ -601,12 +611,10 @@ package body Prj.Part is
(In_Tree : Project_Node_Tree_Ref;
Context_Clause : out With_Id)
is
Current_With_Clause : With_Id := No_With;
Limited_With : Boolean := False;
Current_With : With_Record;
Current_With_Node : Project_Node_Id := Empty_Node;
Current_With_Clause : With_Id := No_With;
Limited_With : Boolean := False;
Current_With : With_Record;
Current_With_Node : Project_Node_Id := Empty_Node;
begin
-- Assume no context clause
......@@ -704,7 +712,8 @@ package body Prj.Part is
From_Extended : Extension_Origin;
In_Limited : Boolean;
Packages_To_Check : String_List_Access;
Depth : Natural)
Depth : Natural;
Current_Dir : String)
is
Current_With_Clause : With_Id := Context_Clause;
......@@ -739,7 +748,8 @@ package body Prj.Part is
Resolved_Path : constant String :=
Normalize_Pathname
(Imported_Path_Name,
Resolve_Links => True,
Directory => Current_Dir,
Resolve_Links => Opt.Follow_Links_For_Files,
Case_Sensitive => True);
Withed_Project : Project_Node_Id := Empty_Node;
......@@ -828,7 +838,8 @@ package body Prj.Part is
From_Extended => From_Extended,
In_Limited => Limited_With,
Packages_To_Check => Packages_To_Check,
Depth => Depth);
Depth => Depth,
Current_Dir => Current_Dir);
else
Extends_All := Is_Extending_All (Withed_Project, In_Tree);
......@@ -887,7 +898,8 @@ package body Prj.Part is
From_Extended : Extension_Origin;
In_Limited : Boolean;
Packages_To_Check : String_List_Access;
Depth : Natural)
Depth : Natural;
Current_Dir : String)
is
Normed_Path_Name : Path_Name_Type;
Canonical_Path_Name : Path_Name_Type;
......@@ -918,11 +930,15 @@ package body Prj.Part is
declare
Normed_Path : constant String := Normalize_Pathname
(Path_Name, Resolve_Links => False,
Case_Sensitive => True);
(Path_Name,
Directory => Current_Dir,
Resolve_Links => False,
Case_Sensitive => True);
Canonical_Path : constant String := Normalize_Pathname
(Normed_Path, Resolve_Links => True,
Case_Sensitive => False);
(Normed_Path,
Directory => Current_Dir,
Resolve_Links => Opt.Follow_Links_For_Files,
Case_Sensitive => False);
begin
Name_Len := Normed_Path'Length;
......@@ -1224,16 +1240,17 @@ package body Prj.Part is
From_Extended => From_Ext,
In_Limited => In_Limited,
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);
end;
if not In_Configuration then
declare
Name_And_Node : Tree_Private_Part.Project_Name_And_Node :=
Tree_Private_Part.Projects_Htable.Get_First
(In_Tree.Projects_HT);
Project_Name : Name_Id := Name_And_Node.Name;
Tree_Private_Part.Projects_Htable.Get_First
(In_Tree.Projects_HT);
Project_Name : Name_Id := Name_And_Node.Name;
begin
-- Check if we already have a project with this name
......@@ -1340,7 +1357,8 @@ package body Prj.Part is
From_Extended => From_Ext,
In_Limited => In_Limited,
Packages_To_Check => Packages_To_Check,
Depth => Depth + 1);
Depth => Depth + 1,
Current_Dir => Current_Dir);
end;
-- A project that extends an extending-all project is also
......@@ -1561,9 +1579,9 @@ package body Prj.Part 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;
Index : Positive;
First : Natural := Canonical'Last;
Last : Natural := First;
Index : Positive;
begin
if Current_Verbosity = High then
......@@ -1694,7 +1712,35 @@ package body Prj.Part is
(Project_File_Name : String;
Directory : String) return String
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
if Current_Verbosity = High then
......@@ -1705,70 +1751,60 @@ package body Prj.Part is
Write_Line (""");");
end if;
if not Is_Absolute_Path (Project_File_Name) then
-- First we try <directory>/<file_name>.<extension>
-- Check the project cache
if Current_Verbosity = High then
Write_Str (" Trying ");
Write_Str (Directory);
Write_Char (Directory_Separator);
Write_Str (Project_File_Name);
Write_Line (Project_File_Extension);
end if;
Name_Len := Project_File_Name'Length;
Name_Buffer (1 .. Name_Len) := Project_File_Name;
Key := Name_Find;
Result_Id := Projects_Paths.Get (Key);
Result :=
Locate_Regular_File
(File_Name => Directory & Directory_Separator &
Project_File_Name & Project_File_Extension,
Path => Project_Path);
if Result_Id /= No_Path then
return Get_Name_String (Result_Id);
end if;
-- 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
if Current_Verbosity = High then
Write_Str (" Trying ");
Write_Str (Directory);
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);
Check_Dot : for K in reverse Project_File_Name'Range loop
if Project_File_Name (K) = '.' then
Has_Dot := True;
exit Check_Dot;
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
Write_Str (" Trying ");
Write_Str (Project_File_Name);
Write_Line (Project_File_Extension);
-- First we try <directory>/<file_name>.<extension>
if not Has_Dot then
Result := Try_Path_Name
(Directory & Directory_Separator &
Project_File_Name & Project_File_Extension);
end if;
Result :=
Locate_Regular_File
(File_Name => Project_File_Name & Project_File_Extension,
Path => Project_Path);
-- Then we try <directory>/<file_name>
if Result = null then
Result := Try_Path_Name
(Directory & Directory_Separator & Project_File_Name);
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
Write_Str (" Trying ");
Write_Line (Project_File_Name);
end if;
-- Then we try <file_name>
Result :=
Locate_Regular_File
(File_Name => Project_File_Name,
Path => Project_Path);
if Result = null then
Result := Try_Path_Name (Project_File_Name);
end if;
-- If we cannot find the project file, we return an empty string
......@@ -1781,10 +1817,16 @@ package body Prj.Part is
Final_Result : constant String :=
GNAT.OS_Lib.Normalize_Pathname
(Result.all,
Directory => Directory,
Resolve_Links => False,
Case_Sensitive => True);
begin
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;
end;
end if;
......
gcc/ada/prj-part.ads
......@@ -35,7 +35,8 @@ package Prj.Part is
Project_File_Name : String;
Always_Errout_Finalize : Boolean;
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.
-- 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,
......@@ -44,6 +45,9 @@ package Prj.Part is
-- where any unknown attribute produces an error. For other packages, an
-- unknown attribute produces a warning. When Store_Comments is True,
-- 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 of parameter From_Extended for procedures Parse_Single_Project and
......@@ -59,7 +63,8 @@ package Prj.Part is
From_Extended : Extension_Origin;
In_Limited : Boolean;
Packages_To_Check : String_List_Access;
Depth : Natural);
Depth : Natural;
Current_Dir : String);
-- 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
......
gcc/ada/prj-proc.adb
......@@ -77,10 +77,11 @@ package body Prj.Proc is
procedure Check
(In_Tree : Project_Tree_Ref;
Project : Project_Id;
Follow_Links : Boolean;
Current_Dir : String;
When_No_Sources : Error_Warning);
-- Set all projects to not checked, then call Recursive_Check for the
-- 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
(From : Declarations;
......@@ -140,11 +141,12 @@ package body Prj.Proc is
procedure Recursive_Check
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Follow_Links : Boolean;
Current_Dir : String;
When_No_Sources : Error_Warning);
-- If Project is not marked as checked, mark it as checked, call
-- Check_Naming_Scheme for the project, then call itself for a
-- possible extended project and all the imported projects of Project.
-- Current_Dir is for optimization purposes, avoiding extra system calls.
---------
-- Add --
......@@ -258,7 +260,7 @@ package body Prj.Proc is
procedure Check
(In_Tree : Project_Tree_Ref;
Project : Project_Id;
Follow_Links : Boolean;
Current_Dir : String;
When_No_Sources : Error_Warning)
is
begin
......@@ -270,8 +272,7 @@ package body Prj.Proc is
In_Tree.Projects.Table (Index).Checked := False;
end loop;
Recursive_Check
(Project, In_Tree, Follow_Links, When_No_Sources);
Recursive_Check (Project, In_Tree, Current_Dir, When_No_Sources);
-- Set the Other_Part field for the units
......@@ -1209,9 +1210,9 @@ package body Prj.Proc is
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
Report_Error : Put_Line_Access;
Follow_Links : Boolean := True;
When_No_Sources : Error_Warning := Error;
Reset_Tree : Boolean := True)
Reset_Tree : Boolean := True;
Current_Dir : String := "")
is
begin
Process_Project_Tree_Phase_1
......@@ -1231,8 +1232,8 @@ package body Prj.Proc is
From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree,
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 Process;
......@@ -2292,8 +2293,8 @@ package body Prj.Proc is
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
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
Obj_Dir : Path_Name_Type;
Extending : Project_Id;
......@@ -2306,8 +2307,7 @@ package body Prj.Proc is
Success := True;
if Project /= No_Project then
Check
(In_Tree, Project, Follow_Links, When_No_Sources);
Check (In_Tree, Project, Current_Dir, When_No_Sources);
end if;
-- If main project is an extending all project, set the object
......@@ -2428,7 +2428,7 @@ package body Prj.Proc is
procedure Recursive_Check
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Follow_Links : Boolean;
Current_Dir : String;
When_No_Sources : Error_Warning)
is
Data : Project_Data;
......@@ -2451,8 +2451,7 @@ package body Prj.Proc is
-- Call itself for a possible extended project.
-- (if there is no extended project, then nothing happens).
Recursive_Check
(Data.Extends, In_Tree, Follow_Links, When_No_Sources);
Recursive_Check (Data.Extends, In_Tree, Current_Dir, When_No_Sources);
-- Call itself for all imported projects
......@@ -2461,7 +2460,7 @@ package body Prj.Proc is
Recursive_Check
(In_Tree.Project_Lists.Table
(Imported_Project_List).Project,
In_Tree, Follow_Links, When_No_Sources);
In_Tree, Current_Dir, When_No_Sources);
Imported_Project_List :=
In_Tree.Project_Lists.Table
(Imported_Project_List).Next;
......@@ -2474,7 +2473,8 @@ package body Prj.Proc is
end if;
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 Recursive_Check;
......
gcc/ada/prj-proc.ads
......@@ -38,17 +38,14 @@ package Prj.Proc is
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
Report_Error : Put_Line_Access;
Follow_Links : Boolean := True;
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
-- Report_Error is null, use the error reporting mechanism. Otherwise,
-- report errors using Report_Error.
--
-- If Follow_Links is False, it is assumed that the project doesn't contain
-- 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.
-- Current_Dir is for optimization purposes, avoiding extra system calls.
--
-- When_No_Sources indicates what should be done when no sources are found
-- in a project for a specified or implied language.
......@@ -79,8 +76,8 @@ package Prj.Proc is
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
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
end Prj.Proc;
gcc/ada/prj.adb
......@@ -232,10 +232,6 @@ package body Prj is
Naming : Naming_Data) return File_Name_Type
is
Language_Id : Name_Id;
Element_Id : Array_Element_Id;
Element : Array_Element;
Suffix : File_Name_Type := No_File;
Lang : Language_Index;
begin
Name_Len := 0;
......@@ -243,6 +239,29 @@ package body Prj is
To_Lower (Name_Buffer (1 .. Name_Len));
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;
while Element_Id /= No_Array_Element loop
Element := In_Tree.Array_Elements.Table (Element_Id);
......@@ -526,8 +545,7 @@ package body Prj is
In_Tree.Projects.Table (Project).Seen := True;
Action (Project, With_State);
List :=
In_Tree.Projects.Table (Project).Imported_Projects;
List := In_Tree.Projects.Table (Project).Imported_Projects;
while List /= Empty_Project_List loop
Recursive_Check (In_Tree.Project_Lists.Table (List).Project);
List := In_Tree.Project_Lists.Table (List).Next;
......@@ -560,6 +578,9 @@ package body Prj is
-- 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
begin
return Hash (Get_Name_String (Name));
......@@ -644,25 +665,16 @@ package body Prj is
function Is_A_Language
(Tree : Project_Tree_Ref;
Data : Project_Data;
Language_Name : String) return Boolean
Language_Name : Name_Id) return Boolean
is
Lang_Id : Name_Id;
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
declare
List : Name_List_Index := Data.Languages;
begin
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;
else
List := Tree.Name_Lists.Table (List).Next;
end if;
......@@ -671,15 +683,14 @@ package body Prj is
else
declare
Lang_Ind : Language_Index;
Lang_Ind : Language_Index := Data.First_Language_Processing;
Lang_Data : Language_Data;
begin
Lang_Ind := Data.First_Language_Processing;
while Lang_Ind /= No_Language_Index loop
Lang_Data := Tree.Languages_Data.Table (Lang_Ind);
if Lang_Data.Name = Lang_Id then
if Lang_Data.Name = Language_Name then
return True;
end if;
......@@ -734,10 +745,11 @@ package body Prj is
when others =>
declare
Supp : Supp_Language;
Supp_Index : Supp_Language_Index := In_Project.Supp_Languages;
Supp : Supp_Language;
Supp_Index : Supp_Language_Index;
begin
Supp_Index := In_Project.Supp_Languages;
while Supp_Index /= No_Supp_Language_Index loop
Supp := In_Tree.Present_Languages.Table (Supp_Index);
......@@ -772,11 +784,11 @@ package body Prj is
when others =>
declare
Supp : Supp_Language_Data;
Supp_Index : Supp_Language_Index :=
In_Project.Supp_Language_Processing;
Supp : Supp_Language_Data;
Supp_Index : Supp_Language_Index;
begin
Supp_Index := In_Project.Supp_Language_Processing;
while Supp_Index /= No_Supp_Language_Index loop
Supp := In_Tree.Supp_Languages.Table (Supp_Index);
......@@ -811,7 +823,6 @@ package body Prj is
Language_Id := Name_Find;
Lang := In_Tree.First_Language;
while Lang /= No_Language_Index loop
if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
return
......@@ -870,12 +881,11 @@ package body Prj is
Name_Buffer (1 .. Name_Len) := To_Lower (Name_Buffer (1 .. Name_Len));
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
-- 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
Element := In_Tree.Array_Elements.Table (Suffix);
......@@ -911,12 +921,11 @@ package body Prj is
Array_Element_Table.Last (In_Tree.Array_Elements);
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
-- 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
Element := In_Tree.Array_Elements.Table (Suffix);
......@@ -1048,17 +1057,17 @@ package body Prj is
when others =>
declare
Supp : Supp_Language;
Supp_Index : Supp_Language_Index := In_Project.Supp_Languages;
Supp : Supp_Language;
Supp_Index : Supp_Language_Index;
begin
Supp_Index := In_Project.Supp_Languages;
while Supp_Index /= No_Supp_Language_Index loop
Supp := In_Tree.Present_Languages.Table
(Supp_Index);
Supp := In_Tree.Present_Languages.Table (Supp_Index);
if Supp.Index = Language then
In_Tree.Present_Languages.Table
(Supp_Index).Present := Present;
In_Tree.Present_Languages.Table (Supp_Index).Present :=
Present;
return;
end if;
......@@ -1069,8 +1078,8 @@ package body Prj is
Next => In_Project.Supp_Languages);
Present_Language_Table.Increment_Last
(In_Tree.Present_Languages);
Supp_Index := Present_Language_Table.Last
(In_Tree.Present_Languages);
Supp_Index :=
Present_Language_Table.Last (In_Tree.Present_Languages);
In_Tree.Present_Languages.Table (Supp_Index) :=
Supp;
In_Project.Supp_Languages := Supp_Index;
......@@ -1095,7 +1104,7 @@ package body Prj is
when others =>
declare
Supp : Supp_Language_Data;
Supp : Supp_Language_Data;
Supp_Index : Supp_Language_Index;
begin
......@@ -1140,18 +1149,16 @@ package body Prj is
when others =>
declare
Supp : Supp_Suffix;
Supp_Index : Supp_Language_Index :=
In_Project.Naming.Supp_Suffixes;
Supp : Supp_Suffix;
Supp_Index : Supp_Language_Index;
begin
Supp_Index := In_Project.Naming.Supp_Suffixes;
while Supp_Index /= No_Supp_Language_Index loop
Supp := In_Tree.Supp_Suffixes.Table
(Supp_Index);
Supp := In_Tree.Supp_Suffixes.Table (Supp_Index);
if Supp.Index = For_Language then
In_Tree.Supp_Suffixes.Table
(Supp_Index).Suffix := Suffix;
In_Tree.Supp_Suffixes.Table (Supp_Index).Suffix := Suffix;
return;
end if;
......@@ -1160,10 +1167,8 @@ package body Prj is
Supp := (Index => For_Language, Suffix => Suffix,
Next => In_Project.Naming.Supp_Suffixes);
Supp_Suffix_Table.Increment_Last
(In_Tree.Supp_Suffixes);
Supp_Index := Supp_Suffix_Table.Last
(In_Tree.Supp_Suffixes);
Supp_Suffix_Table.Increment_Last (In_Tree.Supp_Suffixes);
Supp_Index := Supp_Suffix_Table.Last (In_Tree.Supp_Suffixes);
In_Tree.Supp_Suffixes.Table (Supp_Index) := Supp;
In_Project.Naming.Supp_Suffixes := Supp_Index;
end;
......@@ -1224,6 +1229,14 @@ package body Prj is
procedure Set_Mode (New_Mode : Mode) is
begin
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;
---------------------
......@@ -1283,10 +1296,6 @@ package body Prj is
Naming : Naming_Data) return File_Name_Type
is
Language_Id : Name_Id;
Element_Id : Array_Element_Id;
Element : Array_Element;
Suffix : File_Name_Type := No_File;
Lang : Language_Index;
begin
Name_Len := 0;
......@@ -1294,8 +1303,29 @@ package body Prj is
To_Lower (Name_Buffer (1 .. Name_Len));
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
Element := In_Tree.Array_Elements.Table (Element_Id);
......@@ -1308,7 +1338,6 @@ package body Prj is
if Current_Mode = Multi_Language then
Lang := In_Tree.First_Language;
while Lang /= No_Language_Index loop
if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
Suffix :=
......@@ -1346,7 +1375,6 @@ package body Prj is
Language_Id := Name_Find;
Element_Id := Naming.Spec_Suffix;
while Element_Id /= No_Array_Element loop
Element := In_Tree.Array_Elements.Table (Element_Id);
......@@ -1359,7 +1387,6 @@ package body Prj is
if Current_Mode = Multi_Language then
Lang := In_Tree.First_Language;
while Lang /= No_Language_Index loop
if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
Suffix :=
......@@ -1416,11 +1443,11 @@ package body Prj is
when others =>
declare
Supp : Supp_Suffix;
Supp_Index : Supp_Language_Index :=
In_Project.Naming.Supp_Suffixes;
Supp : Supp_Suffix;
Supp_Index : Supp_Language_Index;
begin
Supp_Index := In_Project.Naming.Supp_Suffixes;
while Supp_Index /= No_Supp_Language_Index loop
Supp := In_Tree.Supp_Suffixes.Table (Supp_Index);
......
gcc/ada/prj.ads
......@@ -62,6 +62,17 @@ package Prj is
procedure Set_Mode (New_Mode : 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;
pragma Inline (In_Configuration);
......@@ -74,8 +85,8 @@ package Prj is
type Project_Tree_Data;
type Project_Tree_Ref is access all Project_Tree_Data;
-- Reference to a project tree.
-- Several project trees may exist in memory at the same time.
-- Reference to a project tree. Several project trees may exist in memory
-- at the same time.
No_Project_Tree : constant Project_Tree_Ref;
......@@ -260,24 +271,33 @@ package Prj is
-- The table that contains all packages
type Language_Index is new Nat;
-- Index of language data
No_Language_Index : constant Language_Index := 0;
-- Constant indicating that there is no language data
procedure Display_Language_Name
(In_Tree : Project_Tree_Ref;
Language : Language_Index);
-- Output the name of a language
type Header_Num is range 0 .. 2047;
function Hash is new System.HTable.Hash (Header_Num => Header_Num);
type Header_Num is range 0 .. 6150;
-- Size for hash table below. The upper bound is an arbitrary value, the
-- 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 : File_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 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 of dependency to be checked: no dependency file, Makefile fragment
-- or ALI file (for Ada).
Makefile_Dependency_Suffix : constant String := ".d";
ALI_Dependency_Suffix : constant String := ".ali";
......@@ -345,8 +365,6 @@ package Prj is
No_Source : constant Source_Id := 0;
-- All the fields in the below record should be commented ???
type Language_Config is record
Kind : Language_Kind := File_Based;
-- Kind of language. All languages are file based, except Ada which is
......@@ -370,47 +388,104 @@ package Prj is
-- shared libraries. Specified in the configuration. When not specified,
-- 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;
-- 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;
Mapping_Body_Suffix : File_Name_Type := No_File;
Config_File_Switches : Name_List_Index := No_Name_List;
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_Option : Name_List_Index := No_Name_List;
-- Hold the value of attribute Include_Switches, if declared for the
-- language.
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;
-- Name of an environment variable
-- Name of environment variable declared by attribute Include_Path_File
-- for the language.
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;
-- 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;
-- The template for a pragma Source_File_Name(_Project) for a specific
-- file name of a spec.
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_File_Unique : Boolean := False;
Runtime_Project : Path_Name_Type := No_Path;
Binder_Driver : File_Name_Type := No_File;
Binder_Driver_Path : Path_Name_Type := No_Path;
Binder_Required_Switches : Name_List_Index := No_Name_List;
Binder_Prefix : Name_Id := No_Name;
Toolchain_Version : Name_Id := No_Name;
Toolchain_Description : Name_Id := No_Name;
PIC_Option : Name_Id := No_Name;
Objects_Generated : Boolean := True;
-- The template for a pragma Source_File_Name(_Project) for a naming
-- spec pattern.
Config_File_Unique : Boolean := False;
-- Indicate if the config file specified to the compiler needs to be
-- unique. If it is unique, then all config files are concatenated into
-- a temp config file.
Binder_Driver : File_Name_Type := No_File;
-- 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;
-- Record describing the configuration of a language
No_Language_Config : constant Language_Config :=
(Kind => File_Based,
......@@ -437,7 +512,6 @@ package Prj is
Config_Body_Pattern => No_Name,
Config_Spec_Pattern => No_Name,
Config_File_Unique => False,
Runtime_Project => No_Path,
Binder_Driver => No_File,
Binder_Driver_Path => No_Path,
Binder_Required_Switches => No_Name_List,
......@@ -493,30 +567,78 @@ package Prj is
type Source_Kind is (Spec, Impl, Sep);
-- Following record needs full comments on every field ???
type Source_Data is record
Project : Project_Id := No_Project;
-- Project of the source
Language_Name : Name_Id := No_Name;
-- Name of the language of the source
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;
-- List of languages a header file may also be, in addition of
-- language Language_Name.
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;
-- 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;
-- Name of the unit, if language is unit based
Index : Int := 0;
-- Index of the source in a multi unit source file
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;
File : File_Name_Type := No_File;
-- Canonical file name of the source
Display_File : File_Name_Type := No_File;
-- File name of the source, for display purposes
Path : Path_Name_Type := No_Path;
-- Canonical path name of the source
Display_Path : Path_Name_Type := No_Path;
-- Path name of the source, for display purposes
Source_TS : Time_Stamp_Type := Empty_Time_Stamp;
-- Time stamp of the source file
Object_Project : Project_Id := No_Project;
-- Project where the object file is
Object_Exists : Boolean := True;
-- True if an object file exists
Object : File_Name_Type := No_File;
-- File name of the object file
Current_Object_Path : Path_Name_Type := No_Path;
-- Object path of an existing object file
Object_Path : Path_Name_Type := No_Path;
-- Object path of the real object file
Object_TS : Time_Stamp_Type := Empty_Time_Stamp;
-- Object file time stamp
......@@ -525,33 +647,49 @@ package Prj is
-- Dependency file simple name
Current_Dep_Path : Path_Name_Type := No_Path;
-- Path name of an existing dependency file
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;
-- Dependency file time stamp
Switches : File_Name_Type := No_File;
Switches_Path : Path_Name_Type := No_Path;
Switches_TS : Time_Stamp_Type := Empty_Time_Stamp;
Naming_Exception : Boolean := False;
Next_In_Sources : Source_Id := No_Source;
Next_In_Project : Source_Id := No_Source;
Next_In_Lang : Source_Id := No_Source;
Switches : File_Name_Type := No_File;
-- File name of the switches file
Switches_Path : Path_Name_Type := No_Path;
-- Path name of the switches file
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;
No_Source_Data : constant Source_Data :=
(Project => No_Project,
Language_Name => No_Name,
Language => No_Language_Index,
Lang_Kind => File_Based,
Alternate_Languages => No_Alternate_Language,
Kind => Spec,
Dependency => Makefile,
Dependency => None,
Other_Part => No_Source,
Unit => No_Name,
Index => 0,
Locally_Removed => False,
Get_Object => False,
Replaced_By => No_Source,
File => No_File,
Display_File => No_File,
......@@ -855,6 +993,11 @@ package Prj is
Language : String;
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
(In_Tree : Project_Tree_Ref;
Language : String;
......@@ -866,6 +1009,11 @@ package Prj is
Language : String;
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
(In_Tree : Project_Tree_Ref;
Language : String;
......@@ -1034,10 +1182,10 @@ package Prj is
-- True if the project is externally built. In such case, the 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
Config : Project_Configuration;
Config : Project_Configuration;
First_Referred_By : Project_Id := No_Project;
-- The project, if any, that was the first to be known as importing or
......@@ -1141,7 +1289,7 @@ package Prj is
Ada_Sources : String_List_Id := Nil_String;
-- 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.
First_Source : Source_Id := No_Source;
......@@ -1207,7 +1355,7 @@ package Prj is
-- The naming scheme of this project file
First_Language_Processing : Language_Index := No_Language_Index;
-- Comment needed ???
-- First index of the language data in the project
Decl : Declarations := No_Declarations;
-- The declarations (variables, attributes and packages) of this project
......@@ -1229,8 +1377,9 @@ package Prj is
-- use this field directly outside of the compiler, use
-- 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;
-- The cached value of the object path temp file (including library
......@@ -1247,13 +1396,13 @@ package Prj is
-- An indication that the configuration pragmas file is a temporary file
-- 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
Linker_Path : Path_Name_Type := No_Path;
Linker_Path : Path_Name_Type := No_Path;
-- 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
-- Language_Processing'Minimum_Linker_Options.
......@@ -1280,19 +1429,32 @@ package Prj is
-- True if there are comments in the project sources that cannot be kept
-- in the project tree.
-- For gprmake
------------------
-- For gprmake --
------------------
Langs : Languages_In_Project := No_Languages;
Supp_Languages : Supp_Language_Index := No_Supp_Language_Index;
-- Indicate the different languages of the source of this project
Ada_Sources_Present : Boolean := True;
Other_Sources_Present : Boolean := True;
First_Other_Source : Other_Source_Id := No_Other_Source;
Last_Other_Source : Other_Source_Id := No_Other_Source;
Ada_Sources_Present : Boolean := True;
-- True if there are Ada sources in the project
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 :=
Default_First_Language_Processing_Data;
Supp_Language_Processing : Supp_Language_Index := No_Supp_Language_Index;
Default_First_Language_Processing_Data;
Supp_Language_Processing : Supp_Language_Index :=
No_Supp_Language_Index;
-- Language configurations
end record;
function Empty_Project (Tree : Project_Tree_Ref) return Project_Data;
......@@ -1307,7 +1469,9 @@ package Prj is
function Is_A_Language
(Tree : Project_Tree_Ref;
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
(In_Tree : Project_Tree_Ref;
......@@ -1329,12 +1493,12 @@ package Prj is
type File_Name_Data is record
Name : File_Name_Type := No_File;
Index : Int := 0;
Index : Int := 0;
Display_Name : File_Name_Type := No_File;
Path : Path_Name_Type := No_Path;
Display_Path : Path_Name_Type := No_Path;
Project : Project_Id := No_Project;
Needs_Pragma : Boolean := False;
Project : Project_Id := No_Project;
Needs_Pragma : Boolean := False;
end record;
-- File and Path name of a spec or body
......@@ -1389,29 +1553,29 @@ package Prj is
record
-- 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
Languages_Data : Language_Data_Table.Instance;
Name_Lists : Name_List_Table.Instance;
String_Elements : String_Element_Table.Instance;
Variable_Elements : Variable_Element_Table.Instance;
Array_Elements : Array_Element_Table.Instance;
Arrays : Array_Table.Instance;
Packages : Package_Table.Instance;
Project_Lists : Project_List_Table.Instance;
Projects : Project_Table.Instance;
Sources : Source_Data_Table.Instance;
Alt_Langs : Alternate_Language_Table.Instance;
Units : Unit_Table.Instance;
Units_HT : Units_Htable.Instance;
Files_HT : Files_Htable.Instance;
Source_Paths_HT : Source_Paths_Htable.Instance;
Languages_Data : Language_Data_Table.Instance;
Name_Lists : Name_List_Table.Instance;
String_Elements : String_Element_Table.Instance;
Variable_Elements : Variable_Element_Table.Instance;
Array_Elements : Array_Element_Table.Instance;
Arrays : Array_Table.Instance;
Packages : Package_Table.Instance;
Project_Lists : Project_List_Table.Instance;
Projects : Project_Table.Instance;
Sources : Source_Data_Table.Instance;
Alt_Langs : Alternate_Language_Table.Instance;
Units : Unit_Table.Instance;
Units_HT : Units_Htable.Instance;
Files_HT : Files_Htable.Instance;
Source_Paths_HT : Source_Paths_Htable.Instance;
-- For gprmake:
......@@ -1422,7 +1586,7 @@ package Prj is
-- Private part
Private_Part : Private_Project_Tree_Data;
Private_Part : Private_Project_Tree_Data;
end record;
-- Data for a project tree
......@@ -1565,10 +1729,10 @@ private
Ignored : constant Variable_Kind := Single;
Nil_Variable_Value : constant Variable_Value :=
(Project => No_Project,
Kind => Undefined,
Location => No_Location,
Default => False);
(Project => No_Project,
Kind => Undefined,
Location => No_Location,
Default => False);
Virtual_Prefix : constant String := "v$";
-- The prefix for virtual extending projects. Because of the '$', which is
......@@ -1592,7 +1756,7 @@ private
Table_Low_Bound => 1,
Table_Initial => 5,
Table_Increment => 100);
-- Comment ???
-- Table storing the naming data for gnatmake/gprmake
package Path_File_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Path_Name_Type,
......
gcc/ada/switch-m.adb
......@@ -584,7 +584,7 @@ package body Switch.M is
Bad_Switch (Switch_Chars);
else
Follow_Links := True;
Follow_Links_For_Files := True;
end if;
-- 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