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 101 additions and 69 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.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/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