aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorEmmanuel Briot <briot@adacore.com>2009-09-17 10:46:35 +0000
committerArnaud Charlet <charlet@gcc.gnu.org>2009-09-17 12:46:35 +0200
commit52545f22b45c674dcb66ad4df149beb253acd445 (patch)
tree4ec65cf7739dd5e1b857f1c5ca795614aa5d0330 /gcc/ada
parentd9b4a5d344983386125cd8c99ced8b2b6abd1a88 (diff)
downloadgcc-52545f22b45c674dcb66ad4df149beb253acd445.zip
gcc-52545f22b45c674dcb66ad4df149beb253acd445.tar.gz
gcc-52545f22b45c674dcb66ad4df149beb253acd445.tar.bz2
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
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/ChangeLog8
-rw-r--r--gcc/ada/clean.adb2
-rw-r--r--gcc/ada/gnatcmd.adb2
-rw-r--r--gcc/ada/make.adb11
-rw-r--r--gcc/ada/prj-conf.adb13
-rw-r--r--gcc/ada/prj-ext.adb110
-rw-r--r--gcc/ada/prj-ext.ads14
-rw-r--r--gcc/ada/prj-part.adb21
-rw-r--r--gcc/ada/prj-tree.ads11
-rw-r--r--gcc/ada/switch-m.adb8
-rw-r--r--gcc/ada/switch-m.ads8
11 files changed, 131 insertions, 77 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index fe75769..92352f5 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,13 @@
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
diff --git a/gcc/ada/clean.adb b/gcc/ada/clean.adb
index a113e6b..b7bfd05 100644
--- a/gcc/ada/clean.adb
+++ b/gcc/ada/clean.adb
@@ -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;
diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb
index d3f74c0..563b92d 100644
--- a/gcc/ada/gnatcmd.adb
+++ b/gcc/ada/gnatcmd.adb
@@ -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);
diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb
index 5471c971..dacf290 100644
--- a/gcc/ada/make.adb
+++ b/gcc/ada/make.adb
@@ -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);
diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb
index 5783a53..bb70e35 100644
--- a/gcc/ada/prj-conf.adb
+++ b/gcc/ada/prj-conf.adb
@@ -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,
diff --git a/gcc/ada/prj-ext.adb b/gcc/ada/prj-ext.adb
index d5a6b80..2b41c67 100644
--- a/gcc/ada/prj-ext.adb
+++ b/gcc/ada/prj-ext.adb
@@ -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
-
- 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.
@@ -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;
--------------
diff --git a/gcc/ada/prj-ext.ads b/gcc/ada/prj-ext.ads
index 156005a..c960e4e 100644
--- a/gcc/ada/prj-ext.ads
+++ b/gcc/ada/prj-ext.ads
@@ -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.
diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb
index fc0438b..b55afc5 100644
--- a/gcc/ada/prj-part.adb
+++ b/gcc/ada/prj-part.adb
@@ -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;
diff --git a/gcc/ada/prj-tree.ads b/gcc/ada/prj-tree.ads
index 991dbff..31a7424 100644
--- a/gcc/ada/prj-tree.ads
+++ b/gcc/ada/prj-tree.ads
@@ -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
diff --git a/gcc/ada/switch-m.adb b/gcc/ada/switch-m.adb
index 8456ea3..316b77e 100644
--- a/gcc/ada/switch-m.adb
+++ b/gcc/ada/switch-m.adb
@@ -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;
diff --git a/gcc/ada/switch-m.ads b/gcc/ada/switch-m.ads
index 9a6124b..a730176 100644
--- a/gcc/ada/switch-m.ads
+++ b/gcc/ada/switch-m.ads
@@ -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;