Commit 52545f22 by Emmanuel Briot Committed by Arnaud Charlet

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

From-SVN: r151794
parent d9b4a5d3
2009-09-17 Emmanuel Briot <briot@adacore.com> 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): * prj-ext.adb, prj-ext.ads, makeutl.adb (Is_External_Assignment):
Remove duplicate code. Remove duplicate code.
(Prj.Ext): Fix memory leak (Prj.Ext): Fix memory leak
......
...@@ -1691,7 +1691,7 @@ package body Clean is ...@@ -1691,7 +1691,7 @@ package body Clean is
elsif Arg (3) = 'P' then elsif Arg (3) = 'P' then
Prj.Ext.Add_Search_Project_Directory Prj.Ext.Add_Search_Project_Directory
(Arg (4 .. Arg'Last)); (Project_Node_Tree, Arg (4 .. Arg'Last));
else else
Bad_Argument; Bad_Argument;
......
...@@ -1604,7 +1604,7 @@ begin ...@@ -1604,7 +1604,7 @@ begin
and then Argv (Argv'First + 1 .. Argv'First + 2) = "aP" and then Argv (Argv'First + 1 .. Argv'First + 2) = "aP"
then then
Add_Search_Project_Directory Add_Search_Project_Directory
(Argv (Argv'First + 3 .. Argv'Last)); (Project_Node_Tree, Argv (Argv'First + 3 .. Argv'Last));
Remove_Switch (Arg_Num); Remove_Switch (Arg_Num);
......
...@@ -7787,7 +7787,7 @@ package body Make is ...@@ -7787,7 +7787,7 @@ package body Make is
Add_Switch (Argv, Linker, And_Save => And_Save); Add_Switch (Argv, Linker, And_Save => And_Save);
else else
Scan_Make_Switches (Argv, Success); Scan_Make_Switches (Project_Node_Tree, Argv, Success);
end if; end if;
-- If we have seen a regular switch process it -- If we have seen a regular switch process it
...@@ -7926,7 +7926,7 @@ package body Make is ...@@ -7926,7 +7926,7 @@ package body Make is
"project file"); "project file");
else else
Scan_Make_Switches (Argv, Success); Scan_Make_Switches (Project_Node_Tree, Argv, Success);
end if; end if;
-- -d -- -d
...@@ -7943,13 +7943,13 @@ package body Make is ...@@ -7943,13 +7943,13 @@ package body Make is
Make_Failed ("-i cannot be used in conjunction with a " & Make_Failed ("-i cannot be used in conjunction with a " &
"project file"); "project file");
else else
Scan_Make_Switches (Argv, Success); Scan_Make_Switches (Project_Node_Tree, Argv, Success);
end if; end if;
-- -j (need to save the result) -- -j (need to save the result)
elsif Argv (2) = 'j' then elsif Argv (2) = 'j' then
Scan_Make_Switches (Argv, Success); Scan_Make_Switches (Project_Node_Tree, Argv, Success);
if And_Save then if And_Save then
Saved_Maximum_Processes := Maximum_Processes; Saved_Maximum_Processes := Maximum_Processes;
...@@ -8089,7 +8089,8 @@ package body Make is ...@@ -8089,7 +8089,8 @@ package body Make is
-- is passed to the compiler. -- is passed to the compiler.
else else
Scan_Make_Switches (Argv, Gnatmake_Switch_Found); Scan_Make_Switches
(Project_Node_Tree, Argv, Gnatmake_Switch_Found);
if not Gnatmake_Switch_Found then if not Gnatmake_Switch_Found then
Add_Switch (Argv, Compiler, And_Save => And_Save); Add_Switch (Argv, Compiler, And_Save => And_Save);
......
...@@ -783,9 +783,16 @@ package body Prj.Conf is ...@@ -783,9 +783,16 @@ package body Prj.Conf is
Write_Eol; Write_Eol;
elsif not Quiet_Output then elsif not Quiet_Output then
Write_Str ("creating "); -- Display no message if we are creating auto.cgpr, unless in
Write_Str (Simple_Name (Args (3).all)); -- verbose mode
Write_Eol;
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; end if;
Spawn (Gprconfig_Path.all, Args (1 .. Arg_Last) & Switches.all, Spawn (Gprconfig_Path.all, Args (1 .. Arg_Last) & Switches.all,
......
...@@ -23,33 +23,26 @@ ...@@ -23,33 +23,26 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with System.OS_Lib; use System.OS_Lib;
with Hostparm; with Hostparm;
with Makeutl; use Makeutl; with Makeutl; use Makeutl;
with Osint; use Osint; with Osint; use Osint;
with Prj.Tree; use Prj.Tree; with Prj.Tree; use Prj.Tree;
with Sdefault; with Sdefault;
with Table;
package body Prj.Ext is package body Prj.Ext is
No_Project_Default_Dir : constant String := "-"; 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; Uninitialized_Prefix : constant String := '#' & Path_Separator;
-- The project path. Initialized by procedure Initialize_Project_Path -- Prefix to indicate that the project path has not been initilized yet.
-- below. -- Must be two characters long
procedure Initialize_Project_Path; procedure Initialize_Project_Path (Tree : Prj.Tree.Project_Node_Tree_Ref);
-- Initialize Current_Project_Path -- 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 -- -- Add --
--------- ---------
...@@ -76,11 +69,20 @@ package body Prj.Ext is ...@@ -76,11 +69,20 @@ package body Prj.Ext is
-- Add_Search_Project_Directory -- -- 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 begin
Name_Len := 0; if Tree.Project_Path = null then
Add_Str_To_Name_Buffer (Path); Tree.Project_Path := new String'(Uninitialized_Prefix & Path);
Search_Directories.Append (Name_Find);
else
Tmp := Tree.Project_Path;
Tree.Project_Path := new String'(Tmp.all & Path_Separator & Path);
Free (Tmp);
end if;
end Add_Search_Project_Directory; end Add_Search_Project_Directory;
-- Check -- -- Check --
...@@ -110,7 +112,7 @@ package body Prj.Ext is ...@@ -110,7 +112,7 @@ package body Prj.Ext is
-- Initialize_Project_Path -- -- 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; Add_Default_Dir : Boolean := True;
First : Positive; First : Positive;
Last : Positive; Last : Positive;
...@@ -129,38 +131,38 @@ package body Prj.Ext is ...@@ -129,38 +131,38 @@ package body Prj.Ext is
-- May be empty. -- May be empty.
begin 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
Name_Len := 1; -- initialized, we simply replace '#' with '.'
Name_Buffer (Name_Len) := '.';
if Tree.Project_Path = null then
-- If there are directories in the Search_Directories table, add them Tree.Project_Path := new String'('.' & Path_Separator);
else
Tree.Project_Path (Tree.Project_Path'First) := '.';
end if;
for J in 1 .. Search_Directories.Last loop -- Then the reset of the project path (if any) currently contains the
Name_Len := Name_Len + 1; -- directories added through Add_Search_Project_Directory
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 if Gpr_Prj_Path.all /= "" then
Name_Len := Name_Len + 1; Add_Search_Project_Directory (Tree, Gpr_Prj_Path.all);
Name_Buffer (Name_Len) := Path_Separator;
Add_Str_To_Name_Buffer (Gpr_Prj_Path.all);
end if; end if;
Free (Gpr_Prj_Path); Free (Gpr_Prj_Path);
if Ada_Prj_Path.all /= "" then if Ada_Prj_Path.all /= "" then
Name_Len := Name_Len + 1; Add_Search_Project_Directory (Tree, Ada_Prj_Path.all);
Name_Buffer (Name_Len) := Path_Separator;
Add_Str_To_Name_Buffer (Ada_Prj_Path.all);
end if; end if;
Free (Ada_Prj_Path); 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. -- Scan the directory path to see if "-" is one of the directories.
-- Remove each occurrence of "-" and set Add_Default_Dir to False. -- Remove each occurrence of "-" and set Add_Default_Dir to False.
-- Also resolve relative paths and symbolic links. -- Also resolve relative paths and symbolic links.
...@@ -232,6 +234,8 @@ package body Prj.Ext is ...@@ -232,6 +234,8 @@ package body Prj.Ext is
First := Last + 1; First := Last + 1;
end loop; end loop;
Free (Tree.Project_Path);
-- Set the initial value of Current_Project_Path -- Set the initial value of Current_Project_Path
if Add_Default_Dir then if Add_Default_Dir then
...@@ -253,7 +257,7 @@ package body Prj.Ext is ...@@ -253,7 +257,7 @@ package body Prj.Ext is
end if; end if;
else else
Current_Project_Path := Tree.Project_Path :=
new String'(Name_Buffer (1 .. Name_Len) & Path_Separator & new String'(Name_Buffer (1 .. Name_Len) & Path_Separator &
Prefix.all & Prefix.all &
".." & Directory_Separator & ".." & Directory_Separator &
...@@ -265,8 +269,8 @@ package body Prj.Ext is ...@@ -265,8 +269,8 @@ package body Prj.Ext is
end; end;
end if; end if;
if Current_Project_Path = null then if Tree.Project_Path = null then
Current_Project_Path := new String'(Name_Buffer (1 .. Name_Len)); Tree.Project_Path := new String'(Name_Buffer (1 .. Name_Len));
end if; end if;
end Initialize_Project_Path; end Initialize_Project_Path;
...@@ -274,13 +278,15 @@ package body Prj.Ext is ...@@ -274,13 +278,15 @@ package body Prj.Ext is
-- Project_Path -- -- Project_Path --
------------------ ------------------
function Project_Path return String is function Project_Path (Tree : Project_Node_Tree_Ref) return String is
begin begin
if Current_Project_Path = null then if Tree.Project_Path = null
Initialize_Project_Path; or else Tree.Project_Path (Tree.Project_Path'First) = '#'
then
Initialize_Project_Path (Tree);
end if; end if;
return Current_Project_Path.all; return Tree.Project_Path.all;
end Project_Path; end Project_Path;
----------- -----------
...@@ -296,10 +302,12 @@ package body Prj.Ext is ...@@ -296,10 +302,12 @@ package body Prj.Ext is
-- Set_Project_Path -- -- 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 begin
Free (Current_Project_Path); Free (Tree.Project_Path);
Current_Project_Path := new String'(New_Path); Tree.Project_Path := new String'(New_Path);
end Set_Project_Path; end Set_Project_Path;
-------------- --------------
......
...@@ -34,18 +34,26 @@ package Prj.Ext is ...@@ -34,18 +34,26 @@ package Prj.Ext is
-- Project Path -- -- 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 -- Add a directory to the project path. Directories added with this
-- procedure are added in order after the current directory and before -- procedure are added in order after the current directory and before
-- the path given by the environment variable GPR_PROJECT_PATH. A value -- the path given by the environment variable GPR_PROJECT_PATH. A value
-- of "-" will remove the default project directory from the project path. -- 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 -- Return the current value of the project path, either the value set
-- during elaboration of the package or, if procedure Set_Project_Path has -- 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. -- 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 -- Give a new value to the project path. The new value New_Path should
-- always start with the current directory (".") and the path separators -- always start with the current directory (".") and the path separators
-- should be the correct ones for the platform. -- should be the correct ones for the platform.
......
...@@ -212,7 +212,8 @@ package body Prj.Part is ...@@ -212,7 +212,8 @@ package body Prj.Part is
-- file (.cgpr) since some specific checks apply. -- file (.cgpr) since some specific checks apply.
function Project_Path_Name_Of function Project_Path_Name_Of
(Project_File_Name : String; (In_Tree : Project_Node_Tree_Ref;
Project_File_Name : String;
Directory : String) return String; Directory : String) return String;
-- Returns the path name of a project file. Returns an empty string -- Returns the path name of a project file. Returns an empty string
-- if project file cannot be found. -- if project file cannot be found.
...@@ -455,13 +456,14 @@ package body Prj.Part is ...@@ -455,13 +456,14 @@ package body Prj.Part is
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 (In_Tree));
Write_Line (""""); Write_Line ("""");
end if; end if;
declare declare
Path_Name : constant String := 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); Directory => Current_Directory);
begin begin
...@@ -478,7 +480,7 @@ package body Prj.Part is ...@@ -478,7 +480,7 @@ package body Prj.Part is
("project file """ ("project file """
& Project_File_Name & Project_File_Name
& """ not found in " & """ not found in "
& Project_Path); & Project_Path (In_Tree));
Project := Empty_Node; Project := Empty_Node;
return; return;
end if; end if;
...@@ -755,7 +757,8 @@ package body Prj.Part is ...@@ -755,7 +757,8 @@ package body Prj.Part is
Imported_Path_Name : constant String := Imported_Path_Name : constant String :=
Project_Path_Name_Of Project_Path_Name_Of
(Original_Path, (In_Tree,
Original_Path,
Project_Directory_Path); Project_Directory_Path);
Resolved_Path : constant String := Resolved_Path : constant String :=
...@@ -1432,7 +1435,8 @@ package body Prj.Part is ...@@ -1432,7 +1435,8 @@ package body Prj.Part is
Extended_Project_Path_Name : constant String := Extended_Project_Path_Name : constant String :=
Project_Path_Name_Of Project_Path_Name_Of
(Original_Path_Name, (In_Tree,
Original_Path_Name,
Get_Name_String Get_Name_String
(Project_Directory)); (Project_Directory));
...@@ -1909,7 +1913,8 @@ package body Prj.Part is ...@@ -1909,7 +1913,8 @@ package body Prj.Part is
-------------------------- --------------------------
function Project_Path_Name_Of function Project_Path_Name_Of
(Project_File_Name : String; (In_Tree : Project_Node_Tree_Ref;
Project_File_Name : String;
Directory : String) return String Directory : String) return String
is is
...@@ -1922,7 +1927,7 @@ package body Prj.Part is ...@@ -1922,7 +1927,7 @@ package body Prj.Part is
------------------- -------------------
function Try_Path_Name (Path : String) return String_Access 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; First : Natural;
Last : Natural; Last : Natural;
Result : String_Access := null; Result : String_Access := null;
......
...@@ -1387,6 +1387,17 @@ package Prj.Tree is ...@@ -1387,6 +1387,17 @@ package Prj.Tree is
-- through subprogrames in prj-ext.ads). External references are -- through subprogrames in prj-ext.ads). External references are
-- project-tree specific so that one can load the same tree twice but -- project-tree specific so that one can load the same tree twice but
-- have two views of it, for instance. -- 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; end record;
-- The data for a project node tree -- The data for a project node tree
......
...@@ -532,8 +532,9 @@ package body Switch.M is ...@@ -532,8 +532,9 @@ package body Switch.M is
------------------------ ------------------------
procedure Scan_Make_Switches procedure Scan_Make_Switches
(Switch_Chars : String; (Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
Success : out Boolean) Switch_Chars : String;
Success : out Boolean)
is is
Ptr : Integer := Switch_Chars'First; Ptr : Integer := Switch_Chars'First;
Max : constant Integer := Switch_Chars'Last; Max : constant Integer := Switch_Chars'Last;
...@@ -590,7 +591,8 @@ package body Switch.M is ...@@ -590,7 +591,8 @@ package body Switch.M is
and then Switch_Chars (Ptr .. Ptr + 1) = "aP" and then Switch_Chars (Ptr .. Ptr + 1) = "aP"
then then
Add_Search_Project_Directory 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 elsif C = 'v' and then Switch_Chars'Length = 3 then
Ptr := Ptr + 1; Ptr := Ptr + 1;
......
...@@ -30,17 +30,21 @@ ...@@ -30,17 +30,21 @@
-- the otherwise undocumented debug switches that are also recognized. -- the otherwise undocumented debug switches that are also recognized.
with System.OS_Lib; use System.OS_Lib; with System.OS_Lib; use System.OS_Lib;
with Prj.Tree;
package Switch.M is package Switch.M is
procedure Scan_Make_Switches procedure Scan_Make_Switches
(Switch_Chars : String; (Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
Success : out Boolean); Switch_Chars : String;
Success : out Boolean);
-- Scan a gnatmake switch and act accordingly. For switches that are -- Scan a gnatmake switch and act accordingly. For switches that are
-- recognized, Success is set to True. A switch that is not recognized and -- 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 -- 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 -- not return. For all other not recognized switches, Success is set to
-- False, so that the switch may be passed to the compiler. -- 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 procedure Normalize_Compiler_Switches
(Switch_Chars : String; (Switch_Chars : String;
......
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