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):
Remove duplicate code.
(Prj.Ext): Fix memory leak
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;
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);
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
"project file");
else
- Scan_Make_Switches (Argv, Success);
+ Scan_Make_Switches (Project_Node_Tree, Argv, Success);
end if;
-- -d
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;
-- 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);
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,
-- --
------------------------------------------------------------------------------
+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 --
---------
-- 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 --
-- 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;
-- May be empty.
begin
- -- The current directory is always first
-
- Name_Len := 1;
- Name_Buffer (Name_Len) := '.';
-
- -- If there are directories in the Search_Directories table, add them
+ -- 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 '.'
+
+ if Tree.Project_Path = null then
+ 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
- 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;
+ -- Then the reset of the project path (if any) currently contains the
+ -- directories added through Add_Search_Project_Directory
- -- 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.
First := Last + 1;
end loop;
+ Free (Tree.Project_Path);
+
-- Set the initial value of Current_Project_Path
if Add_Default_Dir then
end if;
else
- Current_Project_Path :=
+ Tree.Project_Path :=
new String'(Name_Buffer (1 .. Name_Len) & Path_Separator &
Prefix.all &
".." & Directory_Separator &
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;
-- 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;
-----------
-- 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;
--------------
-- 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.
-- 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.
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
("project file """
& Project_File_Name
& """ not found in "
- & Project_Path);
+ & Project_Path (In_Tree));
Project := Empty_Node;
return;
end if;
Imported_Path_Name : constant String :=
Project_Path_Name_Of
- (Original_Path,
+ (In_Tree,
+ Original_Path,
Project_Directory_Path);
Resolved_Path : constant String :=
Extended_Project_Path_Name : constant String :=
Project_Path_Name_Of
- (Original_Path_Name,
+ (In_Tree,
+ Original_Path_Name,
Get_Name_String
(Project_Directory));
--------------------------
function Project_Path_Name_Of
- (Project_File_Name : String;
+ (In_Tree : Project_Node_Tree_Ref;
+ Project_File_Name : String;
Directory : String) return String
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;
-- 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
------------------------
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;
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;
-- 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;
projects / platform / upstream / linaro-gcc.git / commitdiff