From d5cea4e1bc9036aabe4fdb7ac359f7cd8f5a9e58 Mon Sep 17 00:00:00 2001 From: charlet Date: Thu, 17 Sep 2009 10:46:35 +0000 Subject: [PATCH] 2009-09-17 Emmanuel Briot * 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 git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@151794 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 8 ++++ gcc/ada/clean.adb | 2 +- gcc/ada/gnatcmd.adb | 2 +- gcc/ada/make.adb | 11 +++--- gcc/ada/prj-conf.adb | 13 ++++-- gcc/ada/prj-ext.adb | 110 +++++++++++++++++++++++++++------------------------ gcc/ada/prj-ext.ads | 14 +++++-- gcc/ada/prj-part.adb | 21 ++++++---- gcc/ada/prj-tree.ads | 11 ++++++ gcc/ada/switch-m.adb | 8 ++-- gcc/ada/switch-m.ads | 8 +++- 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 + * 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 + * 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 5471c97..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; -- 2.7.4