diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 763881a98ad..ce4039269c9 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,18 @@ +2011-08-03 Thomas Quinot + + * exp_dist.adb: Minor reformatting. + +2011-08-03 Arnaud Charlet + + * s-taprop-irix.adb, s-taprop-hpux-dce.adb, s-taprop-vms.adb + (ATCB_Key): Removed, not always used. + +2011-08-03 Emmanuel Briot + + * gnatcmd.adb, make.adb, prj.adb, prj.ads, makeutl.adb, makeutl.ads, + clean.adb, prj-conf.adb, prj-env.adb, prj-env.ads (Makeutl): remove + most remaining global variables. + 2011-08-03 Robert Dewar * gnatcmd.adb, prj-proc.adb, mlib-prj.adb, prj.adb, makeutl.ads, diff --git a/gcc/ada/clean.adb b/gcc/ada/clean.adb index 82f70816c9e..e67b48eeae1 100644 --- a/gcc/ada/clean.adb +++ b/gcc/ada/clean.adb @@ -71,6 +71,10 @@ package body Clean is -- Prefix of binder generated file, and number of actual characters used. -- Changed to "b__" for VMS in the body of the package. + Project_Tree : constant Project_Tree_Ref := + new Project_Tree_Data (Is_Root_Tree => True); + -- The project tree + Object_Directory_Path : String_Access := null; -- The path name of the object directory, set with switch -D diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb index 0b25f1a8c0f..60c24685337 100644 --- a/gcc/ada/exp_dist.adb +++ b/gcc/ada/exp_dist.adb @@ -6556,7 +6556,7 @@ package body Exp_Dist is Make_Aggregate (Loc, Component_Associations => New_List ( Make_Component_Association (Loc, - Choices => New_List (Make_Identifier (Loc, Name_Ras)), + Choices => New_List (Make_Identifier (Loc, Name_Ras)), Expression => PolyORB_Support.Helpers.Build_From_Any_Call ( Underlying_RACW_Type (RAS_Type), @@ -9054,8 +9054,8 @@ package body Exp_Dist is if Nkind (Datum) /= N_Attribute_Reference then -- We ignore the value of the length of each - -- dimension, since the target array has already - -- been constrained anyway. + -- dimension, since the target array has already been + -- constrained anyway. if Etype (Datum) /= RTE (RE_Any) then Set_Expression (Assignment, diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index 1f0ce8b5758..f858c8a5c4a 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -67,6 +67,10 @@ procedure GNATCmd is B_Start : String_Ptr := new String'("b~"); -- Prefix of binder generated file, changed to b__ for VMS + Project_Tree : constant Project_Tree_Ref := + new Project_Tree_Data (Is_Root_Tree => True); + -- The project tree + Old_Project_File_Used : Boolean := False; -- This flag indicates a switch -p (for gnatxref and gnatfind) for -- an old fashioned project file. -p cannot be used in conjunction @@ -766,7 +770,7 @@ procedure GNATCmd is while Proj /= null loop if Proj.Project.Config_File_Temp then Delete_Temporary_File - (Project_Tree, Proj.Project.Config_File_Name); + (Project_Tree.Shared, Proj.Project.Config_File_Name); end if; Proj := Proj.Next; @@ -777,7 +781,7 @@ procedure GNATCmd is -- has been created, delete this temporary file. if Temp_File_Name /= No_Path then - Delete_Temporary_File (Project_Tree, Temp_File_Name); + Delete_Temporary_File (Project_Tree.Shared, Temp_File_Name); end if; end Delete_Temp_Config_Files; @@ -1286,7 +1290,9 @@ procedure GNATCmd is is begin Makeutl.Test_If_Relative_Path - (Switch, Parent, Including_Non_Switch => False, Including_RTS => True); + (Switch, Parent, + Do_Fail => Osint.Fail'Access, + Including_Non_Switch => False, Including_RTS => True); end Test_If_Relative_Path; ------------------- @@ -2598,7 +2604,7 @@ begin exception when Error_Exit => if not Keep_Temporary_Files then - Prj.Delete_All_Temp_Files (Project_Tree); + Prj.Delete_All_Temp_Files (Project_Tree.Shared); Delete_Temp_Config_Files; end if; @@ -2606,7 +2612,7 @@ exception when Normal_Exit => if not Keep_Temporary_Files then - Prj.Delete_All_Temp_Files (Project_Tree); + Prj.Delete_All_Temp_Files (Project_Tree.Shared); Delete_Temp_Config_Files; end if; diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 9d52a28d626..1abc9d3fe31 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -158,6 +158,10 @@ package body Make is -- True if gnatmake is invoked with -f -u and one or several mains on the -- command line. + Project_Tree : constant Project_Tree_Ref := + new Project_Tree_Data (Is_Root_Tree => True); + -- The project tree + Main_On_Command_Line : Boolean := False; -- True if gnatmake is invoked with one or several mains on the command -- line. @@ -2359,6 +2363,7 @@ package body Make is new String'(Name_Buffer (1 .. Name_Len)); Test_If_Relative_Path (New_Args (Last_New), + Do_Fail => Make_Failed'Access, Parent => Dir_Path, Including_Non_Switch => False); end if; @@ -2392,6 +2397,7 @@ package body Make is begin Test_If_Relative_Path (New_Args (1), + Do_Fail => Make_Failed'Access, Parent => Dir_Path, Including_Non_Switch => False); Add_Arguments @@ -3968,7 +3974,7 @@ package body Make is begin if not Debug.Debug_Flag_N then Delete_Temp_Config_Files; - Prj.Delete_All_Temp_Files (Project_Tree); + Prj.Delete_All_Temp_Files (Project_Tree.Shared); end if; end Delete_All_Temp_Files; @@ -3991,7 +3997,7 @@ package body Make is while Proj /= null loop if Proj.Project.Config_File_Temp then Delete_Temporary_File - (Project_Tree, Proj.Project.Config_File_Name); + (Project_Tree.Shared, Proj.Project.Config_File_Name); -- Make sure that we don't have a config file for this project, -- in case there are several mains. In this case, we will @@ -5222,29 +5228,34 @@ package body Make is for J in 1 .. Binder_Switches.Last loop Test_If_Relative_Path (Binder_Switches.Table (J), + Do_Fail => Make_Failed'Access, Parent => Dir_Path, Including_L_Switch => False); end loop; for J in 1 .. Saved_Binder_Switches.Last loop Test_If_Relative_Path (Saved_Binder_Switches.Table (J), + Do_Fail => Make_Failed'Access, Parent => Current_Work_Dir.all, Including_L_Switch => False); end loop; for J in 1 .. Linker_Switches.Last loop Test_If_Relative_Path - (Linker_Switches.Table (J), Parent => Dir_Path); + (Linker_Switches.Table (J), Parent => Dir_Path, + Do_Fail => Make_Failed'Access); end loop; for J in 1 .. Saved_Linker_Switches.Last loop Test_If_Relative_Path (Saved_Linker_Switches.Table (J), + Do_Fail => Make_Failed'Access, Parent => Current_Work_Dir.all); end loop; for J in 1 .. Gcc_Switches.Last loop Test_If_Relative_Path (Gcc_Switches.Table (J), + Do_Fail => Make_Failed'Access, Parent => Dir_Path, Including_Non_Switch => False); end loop; @@ -5253,6 +5264,7 @@ package body Make is Test_If_Relative_Path (Saved_Gcc_Switches.Table (J), Parent => Current_Work_Dir.all, + Do_Fail => Make_Failed'Access, Including_Non_Switch => False); end loop; end; @@ -5945,7 +5957,7 @@ package body Make is -- If switch -C was specified, create a binder mapping file if Create_Mapping_File then - Mapping_Path := Create_Binder_Mapping_File; + Mapping_Path := Create_Binder_Mapping_File (Project_Tree); if Mapping_Path /= No_Path then Last_Arg := Last_Arg + 1; @@ -5966,7 +5978,8 @@ package body Make is -- Delete the temporary mapping file if one was created if Mapping_Path /= No_Path then - Delete_Temporary_File (Project_Tree, Mapping_Path); + Delete_Temporary_File + (Project_Tree.Shared, Mapping_Path); end if; -- And reraise the exception @@ -5978,7 +5991,7 @@ package body Make is -- if one was created. if Mapping_Path /= No_Path then - Delete_Temporary_File (Project_Tree, Mapping_Path); + Delete_Temporary_File (Project_Tree.Shared, Mapping_Path); end if; end Bind_Step; end if; @@ -6203,7 +6216,9 @@ package body Make is declare Linker_Options : constant String_List := Linker_Options_Switches - (Main_Project, Project_Tree); + (Main_Project, + Do_Fail => Make_Failed'Access, + In_Tree => Project_Tree); begin for Option in Linker_Options'Range loop Linker_Switches.Increment_Last; @@ -6447,6 +6462,7 @@ package body Make is loop Test_If_Relative_Path (Binder_Switches.Table (J), + Do_Fail => Make_Failed'Access, Parent => Dir_Path, Including_L_Switch => False); end loop; @@ -6454,7 +6470,8 @@ package body Make is J in Last_Linker_Switch + 1 .. Linker_Switches.Last loop Test_If_Relative_Path - (Linker_Switches.Table (J), Parent => Dir_Path); + (Linker_Switches.Table (J), Parent => Dir_Path, + Do_Fail => Make_Failed'Access); end loop; end; @@ -6609,7 +6626,7 @@ package body Make is else Record_Temp_File - (Project_Tree, + (Project_Tree.Shared, Data.Mapping_File_Names (Data.Last_Mapping_File_Names)); end if; @@ -8487,5 +8504,4 @@ begin Prj.Com.Fail := Make_Failed'Access; MLib.Fail := Make_Failed'Access; - Makeutl.Do_Fail := Make_Failed'Access; end Make; diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb index 6d82e4ba698..39a8c0d4fd9 100644 --- a/gcc/ada/makeutl.adb +++ b/gcc/ada/makeutl.adb @@ -204,8 +204,8 @@ package body Makeutl is ------------------------------ function Check_Source_Info_In_ALI - (The_ALI : ALI_Id; - Tree : Project_Tree_Ref) return Boolean + (The_ALI : ALI_Id; + Tree : Project_Tree_Ref) return Boolean is Unit_Name : Name_Id; @@ -221,7 +221,7 @@ package body Makeutl is Name_Len := Name_Len - 2; Unit_Name := Name_Find; - if File_Not_A_Source_Of (Unit_Name, Units.Table (U).Sfile) then + if File_Not_A_Source_Of (Tree, Unit_Name, Units.Table (U).Sfile) then return False; end if; @@ -237,7 +237,7 @@ package body Makeutl is Name_Len := Name_Len - 2; Unit_Name := Name_Find; - if File_Not_A_Source_Of (Unit_Name, WR.Sfile) then + if File_Not_A_Source_Of (Tree, Unit_Name, WR.Sfile) then return False; end if; end if; @@ -289,7 +289,7 @@ package body Makeutl is -- (and then will be for the same unit). if Find_Source - (In_Tree => Project_Tree, + (In_Tree => Tree, Project => No_Project, Base_Name => SD.Sfile) = No_Source then @@ -326,7 +326,9 @@ package body Makeutl is -- Create_Binder_Mapping_File -- -------------------------------- - function Create_Binder_Mapping_File return Path_Name_Type is + function Create_Binder_Mapping_File + (Project_Tree : Project_Tree_Ref) return Path_Name_Type + is Mapping_Path : Path_Name_Type := No_Path; Mapping_FD : File_Descriptor := Invalid_FD; @@ -350,7 +352,7 @@ package body Makeutl is begin Tempdir.Create_Temp_File (Mapping_FD, Mapping_Path); - Record_Temp_File (Project_Tree, Mapping_Path); + Record_Temp_File (Project_Tree.Shared, Mapping_Path); if Mapping_FD /= Invalid_FD then OK := True; @@ -616,8 +618,9 @@ package body Makeutl is -------------------------- function File_Not_A_Source_Of - (Uname : Name_Id; - Sfile : File_Name_Type) return Boolean + (Project_Tree : Project_Tree_Ref; + Uname : Name_Id; + Sfile : File_Name_Type) return Boolean is Unit : constant Unit_Index := Units_Htable.Get (Project_Tree.Units_HT, Uname); @@ -908,6 +911,7 @@ package body Makeutl is function Linker_Options_Switches (Project : Project_Id; + Do_Fail : Fail_Proc; In_Tree : Project_Tree_Ref) return String_List is procedure Recursive_Add @@ -995,6 +999,7 @@ package body Makeutl is Test_If_Relative_Path (Switch => Linker_Options_Buffer (Last_Linker_Option), Parent => Dir_Path, + Do_Fail => Do_Fail, Including_L_Switch => True); end if; @@ -1176,6 +1181,7 @@ package body Makeutl is procedure Test_If_Relative_Path (Switch : in out String_Access; Parent : String; + Do_Fail : Fail_Proc; Including_L_Switch : Boolean := True; Including_Non_Switch : Boolean := True; Including_RTS : Boolean := False) diff --git a/gcc/ada/makeutl.ads b/gcc/ada/makeutl.ads index 73113aebf7e..6e23e567c7e 100644 --- a/gcc/ada/makeutl.ads +++ b/gcc/ada/makeutl.ads @@ -23,28 +23,22 @@ -- -- ------------------------------------------------------------------------------ -with ALI; -with Namet; use Namet; -with Opt; -with Osint; -with Prj; use Prj; -with Prj.Tree; -with Types; use Types; +-- This package contains various subprograms used by the builders, in +-- particular those subprograms related to project management and build +-- queue management. +with ALI; with GNAT.OS_Lib; use GNAT.OS_Lib; +with Namet; use Namet; +with Opt; +with Prj; use Prj; +with Prj.Tree; +with Types; use Types; package Makeutl is type Fail_Proc is access procedure (S : String); - Do_Fail : Fail_Proc := Osint.Fail'Access; - -- Failing procedure called from procedure Test_If_Relative_Path below. May - -- be redirected. - - Project_Tree : constant Project_Tree_Ref := - new Project_Tree_Data (Is_Root_Tree => True); - -- The project tree - Source_Info_Option : constant String := "--source-info="; -- Switch to indicate the source info file @@ -75,7 +69,8 @@ package Makeutl is Last : in out Natural); -- Add a string to a list of strings - function Create_Binder_Mapping_File return Path_Name_Type; + function Create_Binder_Mapping_File + (Project_Tree : Project_Tree_Ref) return Path_Name_Type; -- Create a binder mapping file and returns its path name function Create_Name (Name : String) return File_Name_Type; @@ -101,15 +96,16 @@ package Makeutl is -- Prints out the program name followed by a colon, N and S function File_Not_A_Source_Of - (Uname : Name_Id; - Sfile : File_Name_Type) return Boolean; + (Project_Tree : Project_Tree_Ref; + Uname : Name_Id; + Sfile : File_Name_Type) return Boolean; -- Check that file name Sfile is one of the source of unit Uname. Returns -- True if the unit is in one of the project file, but the file name is not -- one of its source. Returns False otherwise. function Check_Source_Info_In_ALI - (The_ALI : ALI.ALI_Id; - Tree : Project_Tree_Ref) return Boolean; + (The_ALI : ALI.ALI_Id; + Tree : Project_Tree_Ref) return Boolean; -- Check whether all file references in ALI are still valid (i.e. the -- source files are still associated with the same units). Return True -- if everything is still valid. @@ -179,6 +175,7 @@ package Makeutl is function Linker_Options_Switches (Project : Project_Id; + Do_Fail : Fail_Proc; In_Tree : Project_Tree_Ref) return String_List; -- Collect the options specified in the Linker'Linker_Options attributes -- of project Project, in project tree In_Tree, and in the projects that @@ -191,6 +188,7 @@ package Makeutl is procedure Test_If_Relative_Path (Switch : in out String_Access; Parent : String; + Do_Fail : Fail_Proc; Including_L_Switch : Boolean := True; Including_Non_Switch : Boolean := True; Including_RTS : Boolean := False); @@ -200,6 +198,8 @@ package Makeutl is -- switches, Including_L_Switch is False, because the argument of the -L -- switch is not a path. If Including_RTS is True, process also switches -- --RTS=. + -- Do_Fail is called in case of error. Using Osing.Fail might be + -- appropriate. function Path_Or_File_Name (Path : Path_Name_Type) return String; -- Returns a file name if -df is used, otherwise return a path name diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb index c9b526340eb..1e0e87eab7d 100644 --- a/gcc/ada/prj-conf.adb +++ b/gcc/ada/prj-conf.adb @@ -987,7 +987,7 @@ package body Prj.Conf is begin Prj.Env.Create_Temp_File - (In_Tree => Project_Tree, + (Shared => Project_Tree.Shared, Path_FD => Path_FD, Path_Name => Path_Name, File_Use => "configuration file"); diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb index d58f87e540b..58f1ec8c57f 100644 --- a/gcc/ada/prj-env.adb +++ b/gcc/ada/prj-env.adb @@ -901,7 +901,7 @@ package body Prj.Env is -- Start of processing for Create_Mapping_File begin - Create_Temp_File (In_Tree, File, Name, "mapping"); + Create_Temp_File (In_Tree.Shared, File, Name, "mapping"); if Current_Verbosity = High then Debug_Increase_Indent ("Create mapping file ", Name_Id (Name)); @@ -937,7 +937,7 @@ package body Prj.Env is ---------------------- procedure Create_Temp_File - (In_Tree : Project_Tree_Ref; + (Shared : Shared_Project_Tree_Data_Access; Path_FD : out File_Descriptor; Path_Name : out Path_Name_Type; File_Use : String) @@ -951,7 +951,7 @@ package body Prj.Env is & Get_Name_String (Path_Name)); end if; - Record_Temp_File (In_Tree, Path_Name); + Record_Temp_File (Shared, Path_Name); else Prj.Com.Fail @@ -964,12 +964,12 @@ package body Prj.Env is -------------------------- procedure Create_New_Path_File - (In_Tree : Project_Tree_Ref; + (Shared : Shared_Project_Tree_Data_Access; Path_FD : out File_Descriptor; Path_Name : out Path_Name_Type) is begin - Create_Temp_File (In_Tree, Path_FD, Path_Name, "path file"); + Create_Temp_File (Shared, Path_FD, Path_Name, "path file"); end Create_New_Path_File; ------------------------------------ @@ -1392,8 +1392,8 @@ package body Prj.Env is procedure Initialize (In_Tree : Project_Tree_Ref) is begin - In_Tree.Private_Part.Current_Source_Path_File := No_Path; - In_Tree.Private_Part.Current_Object_Path_File := No_Path; + In_Tree.Shared.Private_Part.Current_Source_Path_File := No_Path; + In_Tree.Shared.Private_Part.Current_Object_Path_File := No_Path; end Initialize; ------------------- @@ -1573,6 +1573,8 @@ package body Prj.Env is Objects_Path : Boolean := True) is + Shared : constant Shared_Project_Tree_Data_Access := In_Tree.Shared; + Source_Paths : Source_Path_Table.Instance; Object_Paths : Object_Path_Table.Instance; -- List of source or object dirs. Only computed the first time this @@ -1609,7 +1611,7 @@ package body Prj.Env is In_Tree : Project_Tree_Ref; Dummy : in out Boolean) is - pragma Unreferenced (Dummy); + pragma Unreferenced (Dummy, In_Tree); Path : Path_Name_Type; @@ -1622,8 +1624,7 @@ package body Prj.Env is -- Ada sources. if Has_Ada_Sources (Project) then - Add_To_Source_Path - (Project.Source_Dirs, In_Tree.Shared, Source_Paths); + Add_To_Source_Path (Project.Source_Dirs, Shared, Source_Paths); end if; end if; @@ -1653,8 +1654,7 @@ package body Prj.Env is if Include_Path and then Project.Include_Path_File = No_Path then Source_Path_Table.Init (Source_Paths); Process_Source_Dirs := True; - Create_New_Path_File - (In_Tree, Source_FD, Project.Include_Path_File); + Create_New_Path_File (Shared, Source_FD, Project.Include_Path_File); end if; -- For the object path, we make a distinction depending on @@ -1665,7 +1665,7 @@ package body Prj.Env is Object_Path_Table.Init (Object_Paths); Process_Object_Dirs := True; Create_New_Path_File - (In_Tree, Object_FD, Project.Objects_Path_File_With_Libs); + (Shared, Object_FD, Project.Objects_Path_File_With_Libs); end if; elsif Objects_Path then @@ -1673,7 +1673,7 @@ package body Prj.Env is Object_Path_Table.Init (Object_Paths); Process_Object_Dirs := True; Create_New_Path_File - (In_Tree, Object_FD, Project.Objects_Path_File_Without_Libs); + (Shared, Object_FD, Project.Objects_Path_File_Without_Libs); end if; end if; @@ -1743,39 +1743,39 @@ package body Prj.Env is -- corresponding flags. if Include_Path and then - In_Tree.Private_Part.Current_Source_Path_File /= - Project.Include_Path_File + Shared.Private_Part.Current_Source_Path_File /= + Project.Include_Path_File then - In_Tree.Private_Part.Current_Source_Path_File := + Shared.Private_Part.Current_Source_Path_File := Project.Include_Path_File; Set_Path_File_Var (Project_Include_Path_File, - Get_Name_String (In_Tree.Private_Part.Current_Source_Path_File)); + Get_Name_String (Shared.Private_Part.Current_Source_Path_File)); end if; if Objects_Path then if Including_Libraries then - if In_Tree.Private_Part.Current_Object_Path_File /= + if Shared.Private_Part.Current_Object_Path_File /= Project.Objects_Path_File_With_Libs then - In_Tree.Private_Part.Current_Object_Path_File := + Shared.Private_Part.Current_Object_Path_File := Project.Objects_Path_File_With_Libs; Set_Path_File_Var (Project_Objects_Path_File, Get_Name_String - (In_Tree.Private_Part.Current_Object_Path_File)); + (Shared.Private_Part.Current_Object_Path_File)); end if; else - if In_Tree.Private_Part.Current_Object_Path_File /= + if Shared.Private_Part.Current_Object_Path_File /= Project.Objects_Path_File_Without_Libs then - In_Tree.Private_Part.Current_Object_Path_File := + Shared.Private_Part.Current_Object_Path_File := Project.Objects_Path_File_Without_Libs; Set_Path_File_Var (Project_Objects_Path_File, Get_Name_String - (In_Tree.Private_Part.Current_Object_Path_File)); + (Shared.Private_Part.Current_Object_Path_File)); end if; end if; end if; diff --git a/gcc/ada/prj-env.ads b/gcc/ada/prj-env.ads index 2be3cfe9407..fd14a4a3c3d 100644 --- a/gcc/ada/prj-env.ads +++ b/gcc/ada/prj-env.ads @@ -43,7 +43,7 @@ package Prj.Env is -- corresponding to a source. procedure Create_Temp_File - (In_Tree : Project_Tree_Ref; + (Shared : Shared_Project_Tree_Data_Access; Path_FD : out File_Descriptor; Path_Name : out Path_Name_Type; File_Use : String); @@ -71,7 +71,7 @@ package Prj.Env is -- individual units. procedure Create_New_Path_File - (In_Tree : Project_Tree_Ref; + (Shared : Shared_Project_Tree_Data_Access; Path_FD : out File_Descriptor; Path_Name : out Path_Name_Type); -- Create a new temporary path file, placing file name in Path_Name diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index 86a864266b4..b9c9402e7eb 100644 --- a/gcc/ada/prj.adb +++ b/gcc/ada/prj.adb @@ -118,8 +118,8 @@ package body Prj is --------------------------- procedure Delete_Temporary_File - (Tree : Project_Tree_Ref; - Path : Path_Name_Type) + (Shared : Shared_Project_Tree_Data_Access := null; + Path : Path_Name_Type) is Dont_Care : Boolean; pragma Warnings (Off, Dont_Care); @@ -132,13 +132,15 @@ package body Prj is Delete_File (Get_Name_String (Path), Dont_Care); - for Index in - 1 .. Temp_Files_Table.Last (Tree.Private_Part.Temp_Files) - loop - if Tree.Private_Part.Temp_Files.Table (Index) = Path then - Tree.Private_Part.Temp_Files.Table (Index) := No_Path; - end if; - end loop; + if Shared /= null then + for Index in + 1 .. Temp_Files_Table.Last (Shared.Private_Part.Temp_Files) + loop + if Shared.Private_Part.Temp_Files.Table (Index) = Path then + Shared.Private_Part.Temp_Files.Table (Index) := No_Path; + end if; + end loop; + end if; end if; end Delete_Temporary_File; @@ -146,7 +148,9 @@ package body Prj is -- Delete_All_Temp_Files -- --------------------------- - procedure Delete_All_Temp_Files (Tree : Project_Tree_Ref) is + procedure Delete_All_Temp_Files + (Shared : Shared_Project_Tree_Data_Access) + is Dont_Care : Boolean; pragma Warnings (Off, Dont_Care); @@ -155,9 +159,9 @@ package body Prj is begin if not Debug.Debug_Flag_N then for Index in - 1 .. Temp_Files_Table.Last (Tree.Private_Part.Temp_Files) + 1 .. Temp_Files_Table.Last (Shared.Private_Part.Temp_Files) loop - Path := Tree.Private_Part.Temp_Files.Table (Index); + Path := Shared.Private_Part.Temp_Files.Table (Index); if Path /= No_Path then if Current_Verbosity = High then @@ -169,8 +173,8 @@ package body Prj is end if; end loop; - Temp_Files_Table.Free (Tree.Private_Part.Temp_Files); - Temp_Files_Table.Init (Tree.Private_Part.Temp_Files); + Temp_Files_Table.Free (Shared.Private_Part.Temp_Files); + Temp_Files_Table.Init (Shared.Private_Part.Temp_Files); end if; -- If any of the environment variables ADA_PRJ_INCLUDE_FILE or @@ -178,11 +182,11 @@ package body Prj is -- the empty string. On VMS, this has the effect of deassigning -- the logical names. - if Tree.Private_Part.Current_Source_Path_File /= No_Path then + if Shared.Private_Part.Current_Source_Path_File /= No_Path then Setenv (Project_Include_Path_File, ""); end if; - if Tree.Private_Part.Current_Object_Path_File /= No_Path then + if Shared.Private_Part.Current_Object_Path_File /= No_Path then Setenv (Project_Objects_Path_File, ""); end if; end Delete_All_Temp_Files; @@ -712,11 +716,11 @@ package body Prj is ---------------------- procedure Record_Temp_File - (Tree : Project_Tree_Ref; - Path : Path_Name_Type) + (Shared : Shared_Project_Tree_Data_Access; + Path : Path_Name_Type) is begin - Temp_Files_Table.Append (Tree.Private_Part.Temp_Files, Path); + Temp_Files_Table.Append (Shared.Private_Part.Temp_Files, Path); end Record_Temp_File; ---------- @@ -914,6 +918,8 @@ package body Prj is Array_Element_Table.Free (Tree.Shared.Array_Elements); Array_Table.Free (Tree.Shared.Arrays); Package_Table.Free (Tree.Shared.Packages); + + Temp_Files_Table.Free (Tree.Shared.Private_Part.Temp_Files); end if; Source_Paths_Htable.Reset (Tree.Source_Paths_HT); @@ -922,10 +928,6 @@ package body Prj is Free_List (Tree.Projects, Free_Project => True); Free_Units (Tree.Units_HT); - -- Private part - - Temp_Files_Table.Free (Tree.Private_Part.Temp_Files); - Unchecked_Free (Tree); end if; end Free; @@ -953,6 +955,13 @@ package body Prj is Array_Element_Table.Init (Tree.Shared.Array_Elements); Array_Table.Init (Tree.Shared.Arrays); Package_Table.Init (Tree.Shared.Packages); + + -- Private part table + + Temp_Files_Table.Init (Tree.Shared.Private_Part.Temp_Files); + + Tree.Shared.Private_Part.Current_Source_Path_File := No_Path; + Tree.Shared.Private_Part.Current_Object_Path_File := No_Path; end if; Source_Paths_Htable.Reset (Tree.Source_Paths_HT); @@ -963,13 +972,6 @@ package body Prj is Free_List (Tree.Projects, Free_Project => True); Free_Units (Tree.Units_HT); - - -- Private part table - - Temp_Files_Table.Init (Tree.Private_Part.Temp_Files); - - Tree.Private_Part.Current_Source_Path_File := No_Path; - Tree.Private_Part.Current_Object_Path_File := No_Path; end Reset; ------------------- diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index 670e690ec72..43adbe4633c 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -1409,6 +1409,8 @@ package Prj is Array_Elements : Array_Element_Table.Instance; Arrays : Array_Table.Instance; Packages : Package_Table.Instance; + + Private_Part : Private_Project_Tree_Data; end record; type Shared_Project_Tree_Data_Access is access all Shared_Project_Tree_Data; -- The data that is shared among multiple trees, when these trees are @@ -1451,8 +1453,6 @@ package Prj is Source_Info_File_Exists : Boolean := False; -- True when a source info file has been successfully read - Private_Part : Private_Project_Tree_Data; - Shared : Shared_Project_Tree_Data_Access; -- The shared data for this tree and all aggregated trees. @@ -1638,18 +1638,19 @@ package Prj is ---------------- procedure Record_Temp_File - (Tree : Project_Tree_Ref; - Path : Path_Name_Type); + (Shared : Shared_Project_Tree_Data_Access; + Path : Path_Name_Type); -- Record the path of a newly created temporary file, so that it can be -- deleted later. - procedure Delete_All_Temp_Files (Tree : Project_Tree_Ref); + procedure Delete_All_Temp_Files + (Shared : Shared_Project_Tree_Data_Access); -- Delete all recorded temporary files. -- Does nothing if Debug.Debug_Flag_N is set procedure Delete_Temporary_File - (Tree : Project_Tree_Ref; - Path : Path_Name_Type); + (Shared : Shared_Project_Tree_Data_Access := null; + Path : Path_Name_Type); -- Delete a temporary file from the disk. The file is also removed from the -- list of temporary files to delete at the end of the program, in case -- another program running on the same machine has recreated it. diff --git a/gcc/ada/s-taprop-hpux-dce.adb b/gcc/ada/s-taprop-hpux-dce.adb index 814b48b1a5c..164034ec881 100644 --- a/gcc/ada/s-taprop-hpux-dce.adb +++ b/gcc/ada/s-taprop-hpux-dce.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -84,9 +84,6 @@ package body System.Task_Primitives.Operations is -- a time; it is used to execute in mutual exclusion from all other tasks. -- Used mainly in Single_Lock mode, but also to protect All_Tasks_List - ATCB_Key : aliased pthread_key_t; - -- Key used to find the Ada Task_Id associated with a thread - Environment_Task_Id : Task_Id; -- A variable to hold Task_Id for the environment task diff --git a/gcc/ada/s-taprop-irix.adb b/gcc/ada/s-taprop-irix.adb index e73555fb304..3e0b9ab7cd3 100644 --- a/gcc/ada/s-taprop-irix.adb +++ b/gcc/ada/s-taprop-irix.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -78,9 +78,6 @@ package body System.Task_Primitives.Operations is -- a time; it is used to execute in mutual exclusion from all other tasks. -- Used mainly in Single_Lock mode, but also to protect All_Tasks_List - ATCB_Key : aliased pthread_key_t; - -- Key used to find the Ada Task_Id associated with a thread - Environment_Task_Id : Task_Id; -- A variable to hold Task_Id for the environment task diff --git a/gcc/ada/s-taprop-vms.adb b/gcc/ada/s-taprop-vms.adb index 582f88bcbde..5c1770bd8a3 100644 --- a/gcc/ada/s-taprop-vms.adb +++ b/gcc/ada/s-taprop-vms.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -72,9 +72,6 @@ package body System.Task_Primitives.Operations is -- a time; it is used to execute in mutual exclusion from all other tasks. -- Used mainly in Single_Lock mode, but also to protect All_Tasks_List - ATCB_Key : aliased pthread_key_t; - -- Key used to find the Ada Task_Id associated with a thread - Environment_Task_Id : Task_Id; -- A variable to hold Task_Id for the environment task