Skip to content

R
riscv-gcc-1
Commit 98c99a5a by Arnaud Charlet
Options

[multiple changes] 

2011-08-03  Thomas Quinot  <quinot@adacore.com>

	* exp_dist.adb: Minor reformatting.

2011-08-03  Arnaud Charlet  <charlet@adacore.com>

	* s-taprop-irix.adb, s-taprop-hpux-dce.adb, s-taprop-vms.adb
	(ATCB_Key): Removed, not always used.

2011-08-03  Emmanuel Briot  <briot@adacore.com>

	* 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.

From-SVN: r177263
parent 686d0984
Showing with 163 additions and 122 deletions
gcc/ada/ChangeLog
2011-08-03 Thomas Quinot <quinot@adacore.com>
* exp_dist.adb: Minor reformatting.
2011-08-03 Arnaud Charlet <charlet@adacore.com>
* s-taprop-irix.adb, s-taprop-hpux-dce.adb, s-taprop-vms.adb
(ATCB_Key): Removed, not always used.
2011-08-03 Emmanuel Briot <briot@adacore.com>
* 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 <dewar@adacore.com>
* gnatcmd.adb, prj-proc.adb, mlib-prj.adb, prj.adb, makeutl.ads,
......
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
......
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,
......
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;
......
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;
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)
......
gcc/ada/makeutl.ads
......@@ -23,28 +23,22 @@
-- --
------------------------------------------------------------------------------
-- This package contains various subprograms used by the builders, in
-- particular those subprograms related to project management and build
-- queue management.
with ALI;
with Namet; use Namet;
with GNAT.OS_Lib; use GNAT.OS_Lib;
with Namet; use Namet;
with Opt;
with Osint;
with Prj; use Prj;
with Prj; use Prj;
with Prj.Tree;
with Types; use Types;
with GNAT.OS_Lib; use GNAT.OS_Lib;
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
......
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");
......
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;
......
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
......
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;
-------------------
......
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.
......
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
......
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
......
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
......
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