OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

2009-09-17 Emmanuel Briot <briot@adacore.com>

Browse Source 
* gnatcmd.adb, make.adb, prj-part.adb, prj-ext.adb, prj-ext.ads,
	switch-m.adb, switch-m.ads, clean.adb, prj-tree.ads
	(Project_Node_Tree_Data.Project_Path): New field.

	* prj-conf.adb (Do_Autoconf): Remove "creating auto.cgpr" message

From-SVN: r151794
This commit is contained in:
Emmanuel Briot 2009-09-17 10:46:35 +00:00 committed by Arnaud Charlet
parent d9b4a5d344
commit 52545f22b4
11 changed files with 130 additions and 76 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
gcc/ada/ChangeLog
View File

@ -1,3 +1,11 @@
2009-09-17 Emmanuel Briot <briot@adacore.com>
* gnatcmd.adb, make.adb, prj-part.adb, prj-ext.adb, prj-ext.ads,
switch-m.adb, switch-m.ads, clean.adb, prj-tree.ads
(Project_Node_Tree_Data.Project_Path): New field.
* prj-conf.adb (Do_Autoconf): Remove "creating auto.cgpr" message
2009-09-17 Emmanuel Briot <briot@adacore.com>
* prj-ext.adb, prj-ext.ads, makeutl.adb (Is_External_Assignment):

2
gcc/ada/clean.adb
View File

@ -1691,7 +1691,7 @@ package body Clean is
elsif Arg (3) = 'P' then
Prj.Ext.Add_Search_Project_Directory
(Arg (4 .. Arg'Last));
(Project_Node_Tree, Arg (4 .. Arg'Last));
else
Bad_Argument;

2
gcc/ada/gnatcmd.adb
View File

@ -1604,7 +1604,7 @@ begin
and then Argv (Argv'First + 1 .. Argv'First + 2) = "aP"
then
Add_Search_Project_Directory
(Argv (Argv'First + 3 .. Argv'Last));
(Project_Node_Tree, Argv (Argv'First + 3 .. Argv'Last));
Remove_Switch (Arg_Num);

11
gcc/ada/make.adb
View File

@ -7787,7 +7787,7 @@ package body Make is
Add_Switch (Argv, Linker, And_Save => And_Save);
else
Scan_Make_Switches (Argv, Success);
Scan_Make_Switches (Project_Node_Tree, Argv, Success);
end if;
-- If we have seen a regular switch process it
@ -7926,7 +7926,7 @@ package body Make is
"project file");
else
Scan_Make_Switches (Argv, Success);
Scan_Make_Switches (Project_Node_Tree, Argv, Success);
end if;
-- -d
@ -7943,13 +7943,13 @@ package body Make is
Make_Failed ("-i cannot be used in conjunction with a " &
"project file");
else
Scan_Make_Switches (Argv, Success);
Scan_Make_Switches (Project_Node_Tree, Argv, Success);
end if;
-- -j (need to save the result)
elsif Argv (2) = 'j' then
Scan_Make_Switches (Argv, Success);
Scan_Make_Switches (Project_Node_Tree, Argv, Success);
if And_Save then
Saved_Maximum_Processes := Maximum_Processes;
@ -8089,7 +8089,8 @@ package body Make is
-- is passed to the compiler.
else
Scan_Make_Switches (Argv, Gnatmake_Switch_Found);
Scan_Make_Switches
(Project_Node_Tree, Argv, Gnatmake_Switch_Found);
if not Gnatmake_Switch_Found then
Add_Switch (Argv, Compiler, And_Save => And_Save);

13
gcc/ada/prj-conf.adb
View File

@ -783,9 +783,16 @@ package body Prj.Conf is
Write_Eol;
elsif not Quiet_Output then
Write_Str ("creating ");
Write_Str (Simple_Name (Args (3).all));
Write_Eol;
-- Display no message if we are creating auto.cgpr, unless in
-- verbose mode
if Config_File_Name /= ""
or else Verbose_Mode
then
Write_Str ("creating ");
Write_Str (Simple_Name (Args (3).all));
Write_Eol;
end if;
end if;
Spawn (Gprconfig_Path.all, Args (1 .. Arg_Last) & Switches.all,

108
gcc/ada/prj-ext.adb
View File

@ -23,33 +23,26 @@
-- --
------------------------------------------------------------------------------
with System.OS_Lib; use System.OS_Lib;
with Hostparm;
with Makeutl; use Makeutl;
with Osint; use Osint;
with Prj.Tree; use Prj.Tree;
with Makeutl; use Makeutl;
with Osint; use Osint;
with Prj.Tree; use Prj.Tree;
with Sdefault;
with Table;
package body Prj.Ext is
No_Project_Default_Dir : constant String := "-";
-- Indicator in the project path to indicate that the default search
-- directories should not be added to the path
Current_Project_Path : String_Access;
-- The project path. Initialized by procedure Initialize_Project_Path
-- below.
Uninitialized_Prefix : constant String := '#' & Path_Separator;
-- Prefix to indicate that the project path has not been initilized yet.
-- Must be two characters long
procedure Initialize_Project_Path;
procedure Initialize_Project_Path (Tree : Prj.Tree.Project_Node_Tree_Ref);
-- Initialize Current_Project_Path
package Search_Directories is new Table.Table
(Table_Component_Type => Name_Id,
Table_Index_Type => Natural,
Table_Low_Bound => 1,
Table_Initial => 4,
Table_Increment => 100,
Table_Name => "Prj.Ext.Search_Directories");
-- The table for the directories specified with -aP switches
---------
-- Add --
---------
@ -76,11 +69,20 @@ package body Prj.Ext is
-- Add_Search_Project_Directory --
----------------------------------
procedure Add_Search_Project_Directory (Path : String) is
procedure Add_Search_Project_Directory
(Tree : Prj.Tree.Project_Node_Tree_Ref;
Path : String)
is
Tmp : String_Access;
begin
Name_Len := 0;
Add_Str_To_Name_Buffer (Path);
Search_Directories.Append (Name_Find);
if Tree.Project_Path = null then
Tree.Project_Path := new String'(Uninitialized_Prefix & Path);
else
Tmp := Tree.Project_Path;
Tree.Project_Path := new String'(Tmp.all & Path_Separator & Path);
Free (Tmp);
end if;
end Add_Search_Project_Directory;
-- Check --
@ -110,7 +112,7 @@ package body Prj.Ext is
-- Initialize_Project_Path --
-----------------------------
procedure Initialize_Project_Path is
procedure Initialize_Project_Path (Tree : Prj.Tree.Project_Node_Tree_Ref) is
Add_Default_Dir : Boolean := True;
First : Positive;
Last : Positive;
@ -129,38 +131,38 @@ package body Prj.Ext is
-- May be empty.
begin
-- The current directory is always first
-- The current directory is always first in the search path. Since the
-- Project_Path currently starts with '#:' as a sign that it isn't
-- initialized, we simply replace '#' with '.'
Name_Len := 1;
Name_Buffer (Name_Len) := '.';
if Tree.Project_Path = null then
Tree.Project_Path := new String'('.' & Path_Separator);
else
Tree.Project_Path (Tree.Project_Path'First) := '.';
end if;
-- If there are directories in the Search_Directories table, add them
-- Then the reset of the project path (if any) currently contains the
-- directories added through Add_Search_Project_Directory
for J in 1 .. Search_Directories.Last loop
Name_Len := Name_Len + 1;
Name_Buffer (Name_Len) := Path_Separator;
Add_Str_To_Name_Buffer
(Get_Name_String (Search_Directories.Table (J)));
end loop;
-- If environment variable is defined and not empty, add its content
-- If environment variables are defined and not empty, add their content
if Gpr_Prj_Path.all /= "" then
Name_Len := Name_Len + 1;
Name_Buffer (Name_Len) := Path_Separator;
Add_Str_To_Name_Buffer (Gpr_Prj_Path.all);
Add_Search_Project_Directory (Tree, Gpr_Prj_Path.all);
end if;
Free (Gpr_Prj_Path);
if Ada_Prj_Path.all /= "" then
Name_Len := Name_Len + 1;
Name_Buffer (Name_Len) := Path_Separator;
Add_Str_To_Name_Buffer (Ada_Prj_Path.all);
Add_Search_Project_Directory (Tree, Ada_Prj_Path.all);
end if;
Free (Ada_Prj_Path);
-- Copy to Name_Buffer, since we will need to manipulate the path
Name_Len := Tree.Project_Path'Length;
Name_Buffer (1 .. Name_Len) := Tree.Project_Path.all;
-- Scan the directory path to see if "-" is one of the directories.
-- Remove each occurrence of "-" and set Add_Default_Dir to False.
-- Also resolve relative paths and symbolic links.
@ -232,6 +234,8 @@ package body Prj.Ext is
First := Last + 1;
end loop;
Free (Tree.Project_Path);
-- Set the initial value of Current_Project_Path
if Add_Default_Dir then
@ -253,7 +257,7 @@ package body Prj.Ext is
end if;
else
Current_Project_Path :=
Tree.Project_Path :=
new String'(Name_Buffer (1 .. Name_Len) & Path_Separator &
Prefix.all &
".." & Directory_Separator &
@ -265,8 +269,8 @@ package body Prj.Ext is
end;
end if;
if Current_Project_Path = null then
Current_Project_Path := new String'(Name_Buffer (1 .. Name_Len));
if Tree.Project_Path = null then
Tree.Project_Path := new String'(Name_Buffer (1 .. Name_Len));
end if;
end Initialize_Project_Path;
@ -274,13 +278,15 @@ package body Prj.Ext is
-- Project_Path --
------------------
function Project_Path return String is
function Project_Path (Tree : Project_Node_Tree_Ref) return String is
begin
if Current_Project_Path = null then
Initialize_Project_Path;
if Tree.Project_Path = null
or else Tree.Project_Path (Tree.Project_Path'First) = '#'
then
Initialize_Project_Path (Tree);
end if;
return Current_Project_Path.all;
return Tree.Project_Path.all;
end Project_Path;
-----------
@ -296,10 +302,12 @@ package body Prj.Ext is
-- Set_Project_Path --
----------------------
procedure Set_Project_Path (New_Path : String) is
procedure Set_Project_Path
(Tree : Project_Node_Tree_Ref;
New_Path : String) is
begin
Free (Current_Project_Path);
Current_Project_Path := new String'(New_Path);
Free (Tree.Project_Path);
Tree.Project_Path := new String'(New_Path);
end Set_Project_Path;
--------------

14
gcc/ada/prj-ext.ads
View File

@ -34,18 +34,26 @@ package Prj.Ext is
-- Project Path --
------------------
procedure Add_Search_Project_Directory (Path : String);
procedure Add_Search_Project_Directory
(Tree : Prj.Tree.Project_Node_Tree_Ref;
Path : String);
-- Add a directory to the project path. Directories added with this
-- procedure are added in order after the current directory and before
-- the path given by the environment variable GPR_PROJECT_PATH. A value
-- of "-" will remove the default project directory from the project path.
--
-- Calls to this subprogram must be performed before the first call to
-- Project_Path below, or PATH will be added at the end of the search
-- path.
function Project_Path return String;
function Project_Path (Tree : Prj.Tree.Project_Node_Tree_Ref) return String;
-- Return the current value of the project path, either the value set
-- during elaboration of the package or, if procedure Set_Project_Path has
-- been called, the value set by the last call to Set_Project_Path.
procedure Set_Project_Path (New_Path : String);
procedure Set_Project_Path
(Tree : Prj.Tree.Project_Node_Tree_Ref;
New_Path : String);
-- Give a new value to the project path. The new value New_Path should
-- always start with the current directory (".") and the path separators
-- should be the correct ones for the platform.

21
gcc/ada/prj-part.adb
View File

@ -212,7 +212,8 @@ package body Prj.Part is
-- file (.cgpr) since some specific checks apply.
function Project_Path_Name_Of
(Project_File_Name : String;
(In_Tree : Project_Node_Tree_Ref;
Project_File_Name : String;
Directory : String) return String;
-- Returns the path name of a project file. Returns an empty string
-- if project file cannot be found.
@ -455,13 +456,14 @@ package body Prj.Part is
if Current_Verbosity >= Medium then
Write_Str ("GPR_PROJECT_PATH=""");
Write_Str (Project_Path);
Write_Str (Project_Path (In_Tree));
Write_Line ("""");
end if;
declare
Path_Name : constant String :=
Project_Path_Name_Of (Real_Project_File_Name.all,
Project_Path_Name_Of (In_Tree,
Real_Project_File_Name.all,
Directory => Current_Directory);
begin
@ -478,7 +480,7 @@ package body Prj.Part is
("project file """
& Project_File_Name
& """ not found in "
& Project_Path);
& Project_Path (In_Tree));
Project := Empty_Node;
return;
end if;
@ -755,7 +757,8 @@ package body Prj.Part is
Imported_Path_Name : constant String :=
Project_Path_Name_Of
(Original_Path,
(In_Tree,
Original_Path,
Project_Directory_Path);
Resolved_Path : constant String :=
@ -1432,7 +1435,8 @@ package body Prj.Part is
Extended_Project_Path_Name : constant String :=
Project_Path_Name_Of
(Original_Path_Name,
(In_Tree,
Original_Path_Name,
Get_Name_String
(Project_Directory));
@ -1909,7 +1913,8 @@ package body Prj.Part is
--------------------------
function Project_Path_Name_Of
(Project_File_Name : String;
(In_Tree : Project_Node_Tree_Ref;
Project_File_Name : String;
Directory : String) return String
is
@ -1922,7 +1927,7 @@ package body Prj.Part is
-------------------
function Try_Path_Name (Path : String) return String_Access is
Prj_Path : constant String := Project_Path;
Prj_Path : constant String := Project_Path (In_Tree);
First : Natural;
Last : Natural;
Result : String_Access := null;

11
gcc/ada/prj-tree.ads
View File

@ -1387,6 +1387,17 @@ package Prj.Tree is
-- through subprogrames in prj-ext.ads). External references are
-- project-tree specific so that one can load the same tree twice but
-- have two views of it, for instance.
Project_Path : String_Access;
-- The project path, manipulated through subprograms in prj-ext.ads.
-- As a special case, if the first character is '#:" or this variable is
-- unset, this means that the PATH has not been fully initialized yet
-- (although subprograms prj-ext.ads will properly take care of that).
--
-- The project path is tree specific, since we might want to load
-- simultaneously multiple projects, each with its own search path, in
-- particular when using different compilers with different default
-- search directories.
end record;
-- The data for a project node tree

8
gcc/ada/switch-m.adb
View File

@ -532,8 +532,9 @@ package body Switch.M is
------------------------
procedure Scan_Make_Switches
(Switch_Chars : String;
Success : out Boolean)
(Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
Switch_Chars : String;
Success : out Boolean)
is
Ptr : Integer := Switch_Chars'First;
Max : constant Integer := Switch_Chars'Last;
@ -590,7 +591,8 @@ package body Switch.M is
and then Switch_Chars (Ptr .. Ptr + 1) = "aP"
then
Add_Search_Project_Directory
(Switch_Chars (Ptr + 2 .. Switch_Chars'Last));
(Project_Node_Tree,
Switch_Chars (Ptr + 2 .. Switch_Chars'Last));
elsif C = 'v' and then Switch_Chars'Length = 3 then
Ptr := Ptr + 1;

8
gcc/ada/switch-m.ads
View File

@ -30,17 +30,21 @@
-- the otherwise undocumented debug switches that are also recognized.
with System.OS_Lib; use System.OS_Lib;
with Prj.Tree;
package Switch.M is
procedure Scan_Make_Switches
(Switch_Chars : String;
Success : out Boolean);
(Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
Switch_Chars : String;
Success : out Boolean);
-- Scan a gnatmake switch and act accordingly. For switches that are
-- recognized, Success is set to True. A switch that is not recognized and
-- consists of one small letter causes a fatal error exit and control does
-- not return. For all other not recognized switches, Success is set to
-- False, so that the switch may be passed to the compiler.
-- Project_Node_Tree is used to store tree-specific parameters like the
-- project path
procedure Normalize_Compiler_Switches
(Switch_Chars : String;