OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

gnatcmd.adb, [...] (Shared_Project_Tree_Data): new type An aggregate project and its aggregated trees need to share the common... 

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

	* gnatcmd.adb, prj-proc.adb, prj-proc.ads, make.adb, mlib-prj.adb,
	prj.adb, prj.ads, makeutl.adb, makeutl.ads, clean.adb, prj-nmsc.adb,
	prj-util.adb, prj-util.ads, prj-conf.adb, prj-conf.ads, prj-env.adb,
	prj-env.ads (Shared_Project_Tree_Data): new type
	An aggregate project and its aggregated trees need to share the common
	data structures used for lists of strings, packages,... This makes the
	code simpler since otherwise we have to pass the root tree (also used
	for the configuration file data) in addition to the current project
	tree. This also avoids ambiguities as to which tree should be used.
	And finally this saves a bit of memory.
	(For_Every_Project_Imported): new parameter Tree.
	Since aggregated projects are using a different tree, we need to let
	the caller know which tree to use to manipulate the returned project.

From-SVN: r177261
This commit is contained in:
Emmanuel Briot 2011-08-03 10:19:32 +00:00 committed by Arnaud Charlet
parent 9fde638da6
commit 40ecf2f5d1
18 changed files with 1007 additions and 805 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
gcc/ada/ChangeLog
View File

@ -1,3 +1,19 @@
2011-08-03 Emmanuel Briot <briot@adacore.com>
* gnatcmd.adb, prj-proc.adb, prj-proc.ads, make.adb, mlib-prj.adb,
prj.adb, prj.ads, makeutl.adb, makeutl.ads, clean.adb, prj-nmsc.adb,
prj-util.adb, prj-util.ads, prj-conf.adb, prj-conf.ads, prj-env.adb,
prj-env.ads (Shared_Project_Tree_Data): new type
An aggregate project and its aggregated trees need to share the common
data structures used for lists of strings, packages,... This makes the
code simpler since otherwise we have to pass the root tree (also used
for the configuration file data) in addition to the current project
tree. This also avoids ambiguities as to which tree should be used.
And finally this saves a bit of memory.
(For_Every_Project_Imported): new parameter Tree.
Since aggregated projects are using a different tree, we need to let
the caller know which tree to use to manipulate the returned project.
2011-08-03 Robert Dewar <dewar@adacore.com> 2011-08-03 Robert Dewar <dewar@adacore.com>
* prj-proc.adb, exp_util.ads, exp_ch9.adb, make.adb, prj-ext.adb, * prj-proc.adb, exp_util.ads, exp_ch9.adb, make.adb, prj-ext.adb,

6
gcc/ada/clean.adb
View File

@ -1170,7 +1170,7 @@ package body Clean is
Executable := Executable :=
Executable_Of Executable_Of
(Main_Project, (Main_Project,
Project_Tree, Project_Tree.Shared,
Main_Source_File, Main_Source_File,
Current_File_Index); Current_File_Index);
@ -1425,7 +1425,7 @@ package body Clean is
-- Add source directories and object directories to the search paths -- Add source directories and object directories to the search paths
Add_Source_Directories (Main_Project, Project_Tree); Add_Source_Directories (Main_Project, Project_Tree);
Add_Object_Directories (Main_Project); Add_Object_Directories (Main_Project, Project_Tree);
end if; end if;
Osint.Add_Default_Search_Dirs; Osint.Add_Default_Search_Dirs;
@ -1440,7 +1440,7 @@ package body Clean is
Value : String_List_Id := Main_Project.Mains; Value : String_List_Id := Main_Project.Mains;
begin begin
while Value /= Prj.Nil_String loop while Value /= Prj.Nil_String loop
Main := Project_Tree.String_Elements.Table (Value); Main := Project_Tree.Shared.String_Elements.Table (Value);
Osint.Add_File Osint.Add_File
(File_Name => Get_Name_String (Main.Value), (File_Name => Get_Name_String (Main.Value),
Index => Main.Index); Index => Main.Index);

59
gcc/ada/gnatcmd.adb
View File

@ -255,6 +255,7 @@ procedure GNATCmd is
procedure Set_Library_For procedure Set_Library_For
(Project : Project_Id; (Project : Project_Id;
Tree : Project_Tree_Ref;
Libraries_Present : in out Boolean); Libraries_Present : in out Boolean);
-- If Project is a library project, add the correct -L and -l switches to -- If Project is a library project, add the correct -L and -l switches to
-- the linker invocation. -- the linker invocation.
@ -445,7 +446,7 @@ procedure GNATCmd is
B_Start.all & B_Start.all &
MLib.Fil.Ext_To MLib.Fil.Ext_To
(Get_Name_String (Get_Name_String
(Project_Tree.String_Elements.Table (Project_Tree.Shared.String_Elements.Table
(Main).Value), (Main).Value),
"ci")); "ci"));
@ -463,13 +464,13 @@ procedure GNATCmd is
"b__" & "b__" &
MLib.Fil.Ext_To MLib.Fil.Ext_To
(Get_Name_String (Get_Name_String
(Project_Tree.String_Elements.Table (Project_Tree.Shared
(Main).Value), .String_Elements.Table (Main).Value),
"ci")); "ci"));
end if; end if;
Main := Main := Project_Tree.Shared.String_Elements.Table
Project_Tree.String_Elements.Table (Main).Next; (Main).Next;
end loop; end loop;
if Proj.Project.Library then if Proj.Project.Library then
@ -960,7 +961,7 @@ procedure GNATCmd is
-- Check if there are library project files -- Check if there are library project files
if MLib.Tgt.Support_For_Libraries /= None then if MLib.Tgt.Support_For_Libraries /= None then
Set_Libraries (Project, Libraries_Present); Set_Libraries (Project, Project_Tree, Libraries_Present);
end if; end if;
-- If there are, add the necessary additional switches -- If there are, add the necessary additional switches
@ -1236,8 +1237,10 @@ procedure GNATCmd is
procedure Set_Library_For procedure Set_Library_For
(Project : Project_Id; (Project : Project_Id;
Tree : Project_Tree_Ref;
Libraries_Present : in out Boolean) Libraries_Present : in out Boolean)
is is
pragma Unreferenced (Tree);
Path_Option : constant String_Access := Path_Option : constant String_Access :=
MLib.Linker_Library_Path_Option; MLib.Linker_Library_Path_Option;
@ -1870,7 +1873,7 @@ begin
Prj.Util.Value_Of Prj.Util.Value_Of
(Name => Tool_Package_Name, (Name => Tool_Package_Name,
In_Packages => Project.Decl.Packages, In_Packages => Project.Decl.Packages,
In_Tree => Project_Tree); Shared => Project_Tree.Shared);
Element : Package_Element; Element : Package_Element;
@ -1884,7 +1887,7 @@ begin
begin begin
if Pkg /= No_Package then if Pkg /= No_Package then
Element := Project_Tree.Packages.Table (Pkg); Element := Project_Tree.Shared.Packages.Table (Pkg);
-- Packages Gnatls and Gnatstack have a single attribute -- Packages Gnatls and Gnatstack have a single attribute
-- Switches, that is not an associative array. -- Switches, that is not an associative array.
@ -1894,7 +1897,7 @@ begin
Prj.Util.Value_Of Prj.Util.Value_Of
(Variable_Name => Snames.Name_Switches, (Variable_Name => Snames.Name_Switches,
In_Variables => Element.Decl.Attributes, In_Variables => Element.Decl.Attributes,
In_Tree => Project_Tree); Shared => Project_Tree.Shared);
-- Packages Binder (for gnatbind), Cross_Reference (for -- Packages Binder (for gnatbind), Cross_Reference (for
-- gnatxref), Linker (for gnatlink), Finder (for gnatfind), -- gnatxref), Linker (for gnatlink), Finder (for gnatfind),
@ -1926,14 +1929,14 @@ begin
Prj.Util.Value_Of Prj.Util.Value_Of
(Name => Name_Switches, (Name => Name_Switches,
In_Arrays => Element.Decl.Arrays, In_Arrays => Element.Decl.Arrays,
In_Tree => Project_Tree); Shared => Project_Tree.Shared);
Name_Len := 0; Name_Len := 0;
Add_Str_To_Name_Buffer (Main.all); Add_Str_To_Name_Buffer (Main.all);
The_Switches := Prj.Util.Value_Of The_Switches := Prj.Util.Value_Of
(Index => Name_Find, (Index => Name_Find,
Src_Index => 0, Src_Index => 0,
In_Array => Switches_Array, In_Array => Switches_Array,
In_Tree => Project_Tree); Shared => Project_Tree.Shared);
end if; end if;
if The_Switches.Kind = Prj.Undefined then if The_Switches.Kind = Prj.Undefined then
@ -1941,12 +1944,12 @@ begin
Prj.Util.Value_Of Prj.Util.Value_Of
(Name => Name_Default_Switches, (Name => Name_Default_Switches,
In_Arrays => Element.Decl.Arrays, In_Arrays => Element.Decl.Arrays,
In_Tree => Project_Tree); Shared => Project_Tree.Shared);
The_Switches := Prj.Util.Value_Of The_Switches := Prj.Util.Value_Of
(Index => Name_Ada, (Index => Name_Ada,
Src_Index => 0, Src_Index => 0,
In_Array => Switches_Array, In_Array => Switches_Array,
In_Tree => Project_Tree); Shared => Project_Tree.Shared);
end if; end if;
end if; end if;
@ -1973,7 +1976,7 @@ begin
when Prj.List => when Prj.List =>
Current := The_Switches.Values; Current := The_Switches.Values;
while Current /= Prj.Nil_String loop while Current /= Prj.Nil_String loop
The_String := Project_Tree.String_Elements. The_String := Project_Tree.Shared.String_Elements.
Table (Current); Table (Current);
declare declare
@ -2024,7 +2027,7 @@ begin
Prj.Util.Value_Of Prj.Util.Value_Of
(Name => Name_Compiler, (Name => Name_Compiler,
In_Packages => Project.Decl.Packages, In_Packages => Project.Decl.Packages,
In_Tree => Project_Tree); Shared => Project_Tree.Shared);
Element : Package_Element; Element : Package_Element;
@ -2054,7 +2057,7 @@ begin
end if; end if;
end loop; end loop;
Element := Project_Tree.Packages.Table (Pkg); Element := Project_Tree.Shared.Packages.Table (Pkg);
-- If there is a single main and there is compilation -- If there is a single main and there is compilation
-- switches specified in the project file, use them. -- switches specified in the project file, use them.
@ -2069,12 +2072,12 @@ begin
Prj.Util.Value_Of Prj.Util.Value_Of
(Name => Name_Switches, (Name => Name_Switches,
In_Arrays => Element.Decl.Arrays, In_Arrays => Element.Decl.Arrays,
In_Tree => Project_Tree); Shared => Project_Tree.Shared);
The_Switches := Prj.Util.Value_Of The_Switches := Prj.Util.Value_Of
(Index => Main_Id, (Index => Main_Id,
Src_Index => 0, Src_Index => 0,
In_Array => Switches_Array, In_Array => Switches_Array,
In_Tree => Project_Tree); Shared => Project_Tree.Shared);
end if; end if;
-- Otherwise, get the Default_Switches ("Ada") -- Otherwise, get the Default_Switches ("Ada")
@ -2084,12 +2087,12 @@ begin
Prj.Util.Value_Of Prj.Util.Value_Of
(Name => Name_Default_Switches, (Name => Name_Default_Switches,
In_Arrays => Element.Decl.Arrays, In_Arrays => Element.Decl.Arrays,
In_Tree => Project_Tree); Shared => Project_Tree.Shared);
The_Switches := Prj.Util.Value_Of The_Switches := Prj.Util.Value_Of
(Index => Name_Ada, (Index => Name_Ada,
Src_Index => 0, Src_Index => 0,
In_Array => Switches_Array, In_Array => Switches_Array,
In_Tree => Project_Tree); Shared => Project_Tree.Shared);
end if; end if;
-- If there are switches specified, put them in the -- If there are switches specified, put them in the
@ -2112,8 +2115,8 @@ begin
when Prj.List => when Prj.List =>
Current := The_Switches.Values; Current := The_Switches.Values;
while Current /= Prj.Nil_String loop while Current /= Prj.Nil_String loop
The_String := The_String := Project_Tree.Shared.String_Elements
Project_Tree.String_Elements.Table (Current); .Table (Current);
declare declare
Switch : constant String := Switch : constant String :=
@ -2244,7 +2247,7 @@ begin
Prj.Util.Value_Of Prj.Util.Value_Of
(Name => Name_Builder, (Name => Name_Builder,
In_Packages => Project.Decl.Packages, In_Packages => Project.Decl.Packages,
In_Tree => Project_Tree); Shared => Project_Tree.Shared);
Variable : Variable_Value := Variable : Variable_Value :=
Prj.Util.Value_Of Prj.Util.Value_Of
@ -2252,7 +2255,7 @@ begin
Attribute_Or_Array_Name => Attribute_Or_Array_Name =>
Name_Global_Configuration_Pragmas, Name_Global_Configuration_Pragmas,
In_Package => Pkg, In_Package => Pkg,
In_Tree => Project_Tree); Shared => Project_Tree.Shared);
begin begin
if (Variable = Nil_Variable_Value if (Variable = Nil_Variable_Value
@ -2265,7 +2268,7 @@ begin
Attribute_Or_Array_Name => Attribute_Or_Array_Name =>
Name_Global_Config_File, Name_Global_Config_File,
In_Package => Pkg, In_Package => Pkg,
In_Tree => Project_Tree); Shared => Project_Tree.Shared);
end if; end if;
if Variable /= Nil_Variable_Value if Variable /= Nil_Variable_Value
@ -2283,7 +2286,7 @@ begin
Prj.Util.Value_Of Prj.Util.Value_Of
(Name => Name_Compiler, (Name => Name_Compiler,
In_Packages => Project.Decl.Packages, In_Packages => Project.Decl.Packages,
In_Tree => Project_Tree); Shared => Project_Tree.Shared);
Variable : Variable_Value := Variable : Variable_Value :=
Prj.Util.Value_Of Prj.Util.Value_Of
@ -2291,7 +2294,7 @@ begin
Attribute_Or_Array_Name => Attribute_Or_Array_Name =>
Name_Local_Configuration_Pragmas, Name_Local_Configuration_Pragmas,
In_Package => Pkg, In_Package => Pkg,
In_Tree => Project_Tree); Shared => Project_Tree.Shared);
begin begin
if (Variable = Nil_Variable_Value if (Variable = Nil_Variable_Value
@ -2304,7 +2307,7 @@ begin
Attribute_Or_Array_Name => Attribute_Or_Array_Name =>
Name_Local_Config_File, Name_Local_Config_File,
In_Package => Pkg, In_Package => Pkg,
In_Tree => Project_Tree); Shared => Project_Tree.Shared);
end if; end if;
if Variable /= Nil_Variable_Value if Variable /= Nil_Variable_Value

86
gcc/ada/make.adb
View File

@ -1288,7 +1288,8 @@ package body Make is
Switch_List := Switches.Values; Switch_List := Switches.Values;
while Switch_List /= Nil_String loop while Switch_List /= Nil_String loop
Element := Project_Tree.String_Elements.Table (Switch_List); Element :=
Project_Tree.Shared.String_Elements.Table (Switch_List);
Get_Name_String (Element.Value); Get_Name_String (Element.Value);
if Name_Len > 0 then if Name_Len > 0 then
@ -2301,7 +2302,7 @@ package body Make is
Prj.Util.Value_Of Prj.Util.Value_Of
(Name => Name_Compiler, (Name => Name_Compiler,
In_Packages => Arguments_Project.Decl.Packages, In_Packages => Arguments_Project.Decl.Packages,
In_Tree => Project_Tree); Shared => Project_Tree.Shared);
if Compiler_Package /= No_Package then if Compiler_Package /= No_Package then
@ -2332,7 +2333,7 @@ package body Make is
begin begin
while Current /= Nil_String loop while Current /= Nil_String loop
Element := Project_Tree.String_Elements. Element := Project_Tree.Shared.String_Elements.
Table (Current); Table (Current);
Number := Number + 1; Number := Number + 1;
Current := Element.Next; Current := Element.Next;
@ -2348,7 +2349,7 @@ package body Make is
Current := Switches.Values; Current := Switches.Values;
for Index in New_Args'Range loop for Index in New_Args'Range loop
Element := Project_Tree.String_Elements. Element := Project_Tree.Shared.String_Elements.
Table (Current); Table (Current);
Get_Name_String (Element.Value); Get_Name_String (Element.Value);
@ -3851,14 +3852,14 @@ package body Make is
Prj.Util.Value_Of Prj.Util.Value_Of
(Name => Name_Builder, (Name => Name_Builder,
In_Packages => The_Packages, In_Packages => The_Packages,
In_Tree => Project_Tree); Shared => Project_Tree.Shared);
if Gnatmake /= No_Package then if Gnatmake /= No_Package then
Global_Attribute := Prj.Util.Value_Of Global_Attribute := Prj.Util.Value_Of
(Variable_Name => Name_Global_Configuration_Pragmas, (Variable_Name => Name_Global_Configuration_Pragmas,
In_Variables => Project_Tree.Packages.Table In_Variables => Project_Tree.Shared.Packages.Table
(Gnatmake).Decl.Attributes, (Gnatmake).Decl.Attributes,
In_Tree => Project_Tree); Shared => Project_Tree.Shared);
Global_Attribute_Present := Global_Attribute_Present :=
Global_Attribute /= Nil_Variable_Value Global_Attribute /= Nil_Variable_Value
and then Get_Name_String (Global_Attribute.Value) /= ""; and then Get_Name_String (Global_Attribute.Value) /= "";
@ -3894,14 +3895,14 @@ package body Make is
Prj.Util.Value_Of Prj.Util.Value_Of
(Name => Name_Compiler, (Name => Name_Compiler,
In_Packages => The_Packages, In_Packages => The_Packages,
In_Tree => Project_Tree); Shared => Project_Tree.Shared);
if Compiler /= No_Package then if Compiler /= No_Package then
Local_Attribute := Prj.Util.Value_Of Local_Attribute := Prj.Util.Value_Of
(Variable_Name => Name_Local_Configuration_Pragmas, (Variable_Name => Name_Local_Configuration_Pragmas,
In_Variables => Project_Tree.Packages.Table In_Variables => Project_Tree.Shared.Packages.Table
(Compiler).Decl.Attributes, (Compiler).Decl.Attributes,
In_Tree => Project_Tree); Shared => Project_Tree.Shared);
Local_Attribute_Present := Local_Attribute_Present :=
Local_Attribute /= Nil_Variable_Value Local_Attribute /= Nil_Variable_Value
and then Get_Name_String (Local_Attribute.Value) /= ""; and then Get_Name_String (Local_Attribute.Value) /= "";
@ -4183,7 +4184,7 @@ package body Make is
if Main_Project = No_Project then if Main_Project = No_Project then
GNAT.OS_Lib.Spawn (Globalizer_Path.all, Globalizer_Args, Success); GNAT.OS_Lib.Spawn (Globalizer_Path.all, Globalizer_Args, Success);
else else
Globalize_Dirs (Main_Project); Globalize_Dirs (Main_Project, Project_Tree);
end if; end if;
end Globalize; end Globalize;
@ -4535,7 +4536,7 @@ package body Make is
Prj.Util.Value_Of Prj.Util.Value_Of
(Name_Languages, (Name_Languages,
Main_Project.Decl.Attributes, Main_Project.Decl.Attributes,
Project_Tree); Project_Tree.Shared);
Current : String_List_Id; Current : String_List_Id;
Element : String_Element; Element : String_Element;
@ -4551,7 +4552,7 @@ package body Make is
Current := Languages.Values; Current := Languages.Values;
Look_For_Foreign : Look_For_Foreign :
while Current /= Nil_String loop while Current /= Nil_String loop
Element := Project_Tree.String_Elements. Element := Project_Tree.Shared.String_Elements.
Table (Current); Table (Current);
Get_Name_String (Element.Value); Get_Name_String (Element.Value);
To_Lower (Name_Buffer (1 .. Name_Len)); To_Lower (Name_Buffer (1 .. Name_Len));
@ -4574,12 +4575,13 @@ package body Make is
-- line. -- line.
Get_Name_String Get_Name_String
(Project_Tree.String_Elements.Table (Value).Value); (Project_Tree.Shared.String_Elements.Table
(Value).Value);
declare declare
Main_Name : constant String := Main_Name : constant String :=
Get_Name_String Get_Name_String
(Project_Tree.String_Elements.Table (Project_Tree.Shared.String_Elements.Table
(Value).Value); (Value).Value);
Proj : constant Project_Id := Proj : constant Project_Id :=
Prj.Env.Project_Of Prj.Env.Project_Of
@ -4591,10 +4593,10 @@ package body Make is
At_Least_One_Main := True; At_Least_One_Main := True;
Osint.Add_File Osint.Add_File
(Get_Name_String (Get_Name_String
(Project_Tree.String_Elements.Table (Project_Tree.Shared.String_Elements.Table
(Value).Value), (Value).Value),
Index => Index =>
Project_Tree.String_Elements.Table Project_Tree.Shared.String_Elements.Table
(Value).Index); (Value).Index);
elsif not Foreign_Language then elsif not Foreign_Language then
@ -4605,7 +4607,7 @@ package body Make is
end if; end if;
end; end;
Value := Project_Tree.String_Elements.Table Value := Project_Tree.Shared.String_Elements.Table
(Value).Next; (Value).Next;
end loop; end loop;
@ -4765,19 +4767,19 @@ package body Make is
Prj.Util.Value_Of Prj.Util.Value_Of
(Name => Name_Builder, (Name => Name_Builder,
In_Packages => The_Packages, In_Packages => The_Packages,
In_Tree => Project_Tree); Shared => Project_Tree.Shared);
Binder_Package : constant Prj.Package_Id := Binder_Package : constant Prj.Package_Id :=
Prj.Util.Value_Of Prj.Util.Value_Of
(Name => Name_Binder, (Name => Name_Binder,
In_Packages => The_Packages, In_Packages => The_Packages,
In_Tree => Project_Tree); Shared => Project_Tree.Shared);
Linker_Package : constant Prj.Package_Id := Linker_Package : constant Prj.Package_Id :=
Prj.Util.Value_Of Prj.Util.Value_Of
(Name => Name_Linker, (Name => Name_Linker,
In_Packages => The_Packages, In_Packages => The_Packages,
In_Tree => Project_Tree); Shared => Project_Tree.Shared);
Default_Switches_Array : Array_Id; Default_Switches_Array : Array_Id;
@ -4832,20 +4834,20 @@ package body Make is
Global_Compilation_Array := Prj.Util.Value_Of Global_Compilation_Array := Prj.Util.Value_Of
(Name => Name_Global_Compilation_Switches, (Name => Name_Global_Compilation_Switches,
In_Arrays => Project_Tree.Packages.Table In_Arrays => Project_Tree.Shared.Packages.Table
(Builder_Package).Decl.Arrays, (Builder_Package).Decl.Arrays,
In_Tree => Project_Tree); Shared => Project_Tree.Shared);
Default_Switches_Array := Default_Switches_Array :=
Project_Tree.Packages.Table Project_Tree.Shared.Packages.Table
(Builder_Package).Decl.Arrays; (Builder_Package).Decl.Arrays;
while Default_Switches_Array /= No_Array and then while Default_Switches_Array /= No_Array and then
Project_Tree.Arrays.Table (Default_Switches_Array).Name /= Project_Tree.Shared.Arrays.Table (Default_Switches_Array).Name
Name_Default_Switches /= Name_Default_Switches
loop loop
Default_Switches_Array := Default_Switches_Array := Project_Tree.Shared.Arrays.Table
Project_Tree.Arrays.Table (Default_Switches_Array).Next; (Default_Switches_Array).Next;
end loop; end loop;
if Global_Compilation_Array /= No_Array_Element and then if Global_Compilation_Array /= No_Array_Element and then
@ -4854,7 +4856,7 @@ package body Make is
Errutil.Error_Msg Errutil.Error_Msg
("Default_Switches forbidden in presence of " & ("Default_Switches forbidden in presence of " &
"Global_Compilation_Switches. Use Switches instead.", "Global_Compilation_Switches. Use Switches instead.",
Project_Tree.Arrays.Table Project_Tree.Shared.Arrays.Table
(Default_Switches_Array).Location); (Default_Switches_Array).Location);
Errutil.Finalize; Errutil.Finalize;
Make_Failed Make_Failed
@ -4899,15 +4901,15 @@ package body Make is
Name_Default_Switches, Name_Default_Switches,
In_Package => In_Package =>
Builder_Package, Builder_Package,
In_Tree => Project_Tree); Shared => Project_Tree.Shared);
Switches : constant Array_Element_Id := Switches : constant Array_Element_Id :=
Prj.Util.Value_Of Prj.Util.Value_Of
(Name => Name_Switches, (Name => Name_Switches,
In_Arrays => In_Arrays =>
Project_Tree.Packages.Table Project_Tree.Shared.Packages.Table
(Builder_Package).Decl.Arrays, (Builder_Package).Decl.Arrays,
In_Tree => Project_Tree); Shared => Project_Tree.Shared);
Other_Switches : constant Variable_Value := Other_Switches : constant Variable_Value :=
Prj.Util.Value_Of Prj.Util.Value_Of
@ -4916,13 +4918,13 @@ package body Make is
Attribute_Or_Array_Name Attribute_Or_Array_Name
=> Name_Switches, => Name_Switches,
In_Package => Builder_Package, In_Package => Builder_Package,
In_Tree => Project_Tree); Shared => Project_Tree.Shared);
begin begin
if Other_Switches /= Nil_Variable_Value then if Other_Switches /= Nil_Variable_Value then
if not Quiet_Output if not Quiet_Output
and then Switches /= No_Array_Element and then Switches /= No_Array_Element
and then Project_Tree.Array_Elements.Table and then Project_Tree.Shared.Array_Elements.Table
(Switches).Next /= No_Array_Element (Switches).Next /= No_Array_Element
then then
Write_Line Write_Line
@ -4977,7 +4979,7 @@ package body Make is
begin begin
while Global_Compilation_Array /= No_Array_Element loop while Global_Compilation_Array /= No_Array_Element loop
Global_Compilation_Elem := Global_Compilation_Elem :=
Project_Tree.Array_Elements.Table Project_Tree.Shared.Array_Elements.Table
(Global_Compilation_Array); (Global_Compilation_Array);
Get_Name_String (Global_Compilation_Elem.Index); Get_Name_String (Global_Compilation_Elem.Index);
@ -4999,7 +5001,8 @@ package body Make is
while List /= Nil_String loop while List /= Nil_String loop
Elem := Elem :=
Project_Tree.String_Elements.Table (List); Project_Tree.Shared.String_Elements.Table
(List);
if Elem.Value /= No_Name then if Elem.Value /= No_Name then
Add_Switch Add_Switch
@ -5431,7 +5434,8 @@ package body Make is
Executable := Executable :=
Prj.Util.Executable_Of Prj.Util.Executable_Of
(Main_Project, Project_Tree, Main_Source_File, Main_Index); (Main_Project, Project_Tree.Shared,
Main_Source_File, Main_Index);
end if; end if;
end if; end if;
@ -6337,13 +6341,13 @@ package body Make is
Prj.Util.Value_Of Prj.Util.Value_Of
(Name => Name_Binder, (Name => Name_Binder,
In_Packages => The_Packages, In_Packages => The_Packages,
In_Tree => Project_Tree); Shared => Project_Tree.Shared);
Linker_Package : constant Prj.Package_Id := Linker_Package : constant Prj.Package_Id :=
Prj.Util.Value_Of Prj.Util.Value_Of
(Name => Name_Linker, (Name => Name_Linker,
In_Packages => The_Packages, In_Packages => The_Packages,
In_Tree => Project_Tree); Shared => Project_Tree.Shared);
begin begin
-- We fail if we cannot find the main source file -- We fail if we cannot find the main source file
@ -6848,7 +6852,7 @@ package body Make is
-- has its own directories anyway -- has its own directories anyway
Add_Source_Directories (Main_Project, Project_Tree); Add_Source_Directories (Main_Project, Project_Tree);
Add_Object_Directories (Main_Project); Add_Object_Directories (Main_Project, Project_Tree);
Recursive_Compute_Depth (Main_Project); Recursive_Compute_Depth (Main_Project);
Compute_All_Imported_Projects (Project_Tree); Compute_All_Imported_Projects (Project_Tree);
@ -8457,7 +8461,7 @@ package body Make is
(Source_File => Source_File, (Source_File => Source_File,
Source_Lang => Name_Ada, Source_Lang => Name_Ada,
Source_Prj => Project, Source_Prj => Project,
Pkg_Name => Project_Tree.Packages.Table (In_Package).Name, Pkg_Name => Project_Tree.Shared.Packages.Table (In_Package).Name,
Project_Tree => Project_Tree, Project_Tree => Project_Tree,
Value => Switches, Value => Switches,
Is_Default => Is_Default, Is_Default => Is_Default,

35
gcc/ada/makeutl.adb
View File

@ -695,7 +695,7 @@ package body Makeutl is
Prj.Util.Value_Of Prj.Util.Value_Of
(Name => Pkg_Name, (Name => Pkg_Name,
In_Packages => Project.Decl.Packages, In_Packages => Project.Decl.Packages,
In_Tree => Project_Tree); Shared => Project_Tree.Shared);
Lang : Language_Ptr; Lang : Language_Ptr;
begin begin
@ -706,7 +706,7 @@ package body Makeutl is
(Name => Name_Id (Source_File), (Name => Name_Id (Source_File),
Attribute_Or_Array_Name => Name_Switches, Attribute_Or_Array_Name => Name_Switches,
In_Package => Pkg, In_Package => Pkg,
In_Tree => Project_Tree, Shared => Project_Tree.Shared,
Allow_Wildcards => True); Allow_Wildcards => True);
end if; end if;
@ -756,7 +756,7 @@ package body Makeutl is
(Name => Name_Find, (Name => Name_Find,
Attribute_Or_Array_Name => Name_Switches, Attribute_Or_Array_Name => Name_Switches,
In_Package => Pkg, In_Package => Pkg,
In_Tree => Project_Tree, Shared => Project_Tree.Shared,
Allow_Wildcards => True); Allow_Wildcards => True);
end if; end if;
@ -776,7 +776,7 @@ package body Makeutl is
(Name => Name_Find, (Name => Name_Find,
Attribute_Or_Array_Name => Name_Switches, Attribute_Or_Array_Name => Name_Switches,
In_Package => Pkg, In_Package => Pkg,
In_Tree => Project_Tree, Shared => Project_Tree.Shared,
Allow_Wildcards => True); Allow_Wildcards => True);
end if; end if;
end; end;
@ -790,7 +790,7 @@ package body Makeutl is
(Name => Source_Lang, (Name => Source_Lang,
Attribute_Or_Array_Name => Name_Switches, Attribute_Or_Array_Name => Name_Switches,
In_Package => Pkg, In_Package => Pkg,
In_Tree => Project_Tree, Shared => Project_Tree.Shared,
Force_Lower_Case_Index => True); Force_Lower_Case_Index => True);
end if; end if;
@ -800,7 +800,7 @@ package body Makeutl is
(Name => All_Other_Names, (Name => All_Other_Names,
Attribute_Or_Array_Name => Name_Switches, Attribute_Or_Array_Name => Name_Switches,
In_Package => Pkg, In_Package => Pkg,
In_Tree => Project_Tree, Shared => Project_Tree.Shared,
Force_Lower_Case_Index => True); Force_Lower_Case_Index => True);
end if; end if;
@ -810,7 +810,7 @@ package body Makeutl is
(Name => Source_Lang, (Name => Source_Lang,
Attribute_Or_Array_Name => Name_Default_Switches, Attribute_Or_Array_Name => Name_Default_Switches,
In_Package => Pkg, In_Package => Pkg,
In_Tree => Project_Tree); Shared => Project_Tree.Shared);
end if; end if;
end Get_Switches; end Get_Switches;
@ -910,14 +910,21 @@ package body Makeutl is
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref) return String_List In_Tree : Project_Tree_Ref) return String_List
is is
procedure Recursive_Add (Proj : Project_Id; Dummy : in out Boolean); procedure Recursive_Add
(Proj : Project_Id;
In_Tree : Project_Tree_Ref;
Dummy : in out Boolean);
-- The recursive routine used to add linker options -- The recursive routine used to add linker options
------------------- -------------------
-- Recursive_Add -- -- Recursive_Add --
------------------- -------------------
procedure Recursive_Add (Proj : Project_Id; Dummy : in out Boolean) is procedure Recursive_Add
(Proj : Project_Id;
In_Tree : Project_Tree_Ref;
Dummy : in out Boolean)
is
pragma Unreferenced (Dummy); pragma Unreferenced (Dummy);
Linker_Package : Package_Id; Linker_Package : Package_Id;
@ -928,7 +935,7 @@ package body Makeutl is
Prj.Util.Value_Of Prj.Util.Value_Of
(Name => Name_Linker, (Name => Name_Linker,
In_Packages => Proj.Decl.Packages, In_Packages => Proj.Decl.Packages,
In_Tree => In_Tree); Shared => In_Tree.Shared);
Options := Options :=
Prj.Util.Value_Of Prj.Util.Value_Of
@ -936,7 +943,7 @@ package body Makeutl is
Index => 0, Index => 0,
Attribute_Or_Array_Name => Name_Linker_Options, Attribute_Or_Array_Name => Name_Linker_Options,
In_Package => Linker_Package, In_Package => Linker_Package,
In_Tree => In_Tree); Shared => In_Tree.Shared);
-- If attribute is present, add the project with -- If attribute is present, add the project with
-- the attribute to table Linker_Opts. -- the attribute to table Linker_Opts.
@ -958,7 +965,7 @@ package body Makeutl is
begin begin
Linker_Opts.Init; Linker_Opts.Init;
For_All_Projects (Project, Dummy, Imported_First => True); For_All_Projects (Project, In_Tree, Dummy, Imported_First => True);
Last_Linker_Option := 0; Last_Linker_Option := 0;
@ -974,7 +981,7 @@ package body Makeutl is
begin begin
Options := Linker_Opts.Table (Index).Options; Options := Linker_Opts.Table (Index).Options;
while Options /= Nil_String loop while Options /= Nil_String loop
Option := In_Tree.String_Elements.Table (Options).Value; Option := In_Tree.Shared.String_Elements.Table (Options).Value;
Get_Name_String (Option); Get_Name_String (Option);
-- Do not consider empty linker options -- Do not consider empty linker options
@ -991,7 +998,7 @@ package body Makeutl is
Including_L_Switch => True); Including_L_Switch => True);
end if; end if;
Options := In_Tree.String_Elements.Table (Options).Next; Options := In_Tree.Shared.String_Elements.Table (Options).Next;
end loop; end loop;
end; end;
end loop; end loop;

3
gcc/ada/makeutl.ads
View File

@ -40,7 +40,8 @@ package Makeutl is
-- Failing procedure called from procedure Test_If_Relative_Path below. May -- Failing procedure called from procedure Test_If_Relative_Path below. May
-- be redirected. -- be redirected.
Project_Tree : constant Project_Tree_Ref := new Project_Tree_Data; Project_Tree : constant Project_Tree_Ref :=
new Project_Tree_Data (Is_Root_Tree => True);
-- The project tree -- The project tree
Source_Info_Option : constant String := "--source-info="; Source_Info_Option : constant String := "--source-info=";

30
gcc/ada/mlib-prj.adb
View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2001-2010, AdaCore -- -- Copyright (C) 2001-2011, AdaCore --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
@ -901,7 +901,7 @@ package body MLib.Prj is
Value_Of Value_Of
(Name => Name_Binder, (Name => Name_Binder,
In_Packages => For_Project.Decl.Packages, In_Packages => For_Project.Decl.Packages,
In_Tree => In_Tree); Shared => In_Tree.Shared);
begin begin
if Binder_Package /= No_Package then if Binder_Package /= No_Package then
@ -910,9 +910,9 @@ package body MLib.Prj is
Value_Of Value_Of
(Name => Name_Default_Switches, (Name => Name_Default_Switches,
In_Arrays => In_Arrays =>
In_Tree.Packages.Table In_Tree.Shared.Packages.Table
(Binder_Package).Decl.Arrays, (Binder_Package).Decl.Arrays,
In_Tree => In_Tree); Shared => In_Tree.Shared);
Switches : Variable_Value := Nil_Variable_Value; Switches : Variable_Value := Nil_Variable_Value;
Switch : String_List_Id := Nil_String; Switch : String_List_Id := Nil_String;
@ -924,7 +924,7 @@ package body MLib.Prj is
(Index => Name_Ada, (Index => Name_Ada,
Src_Index => 0, Src_Index => 0,
In_Array => Defaults, In_Array => Defaults,
In_Tree => In_Tree); Shared => In_Tree.Shared);
if not Switches.Default then if not Switches.Default then
Switch := Switches.Values; Switch := Switches.Values;
@ -932,9 +932,9 @@ package body MLib.Prj is
while Switch /= Nil_String loop while Switch /= Nil_String loop
Add_Argument Add_Argument
(Get_Name_String (Get_Name_String
(In_Tree.String_Elements.Table (In_Tree.Shared.String_Elements.Table
(Switch).Value)); (Switch).Value));
Switch := In_Tree.String_Elements. Switch := In_Tree.Shared.String_Elements.
Table (Switch).Next; Table (Switch).Next;
end loop; end loop;
end if; end if;
@ -1277,7 +1277,8 @@ package body MLib.Prj is
-- If attribute Library_Options was specified, add these options -- If attribute Library_Options was specified, add these options
Library_Options := Value_Of Library_Options := Value_Of
(Name_Library_Options, For_Project.Decl.Attributes, In_Tree); (Name_Library_Options, For_Project.Decl.Attributes,
In_Tree.Shared);
if not Library_Options.Default then if not Library_Options.Default then
declare declare
@ -1287,7 +1288,7 @@ package body MLib.Prj is
begin begin
Current := Library_Options.Values; Current := Library_Options.Values;
while Current /= Nil_String loop while Current /= Nil_String loop
Element := In_Tree.String_Elements.Table (Current); Element := In_Tree.Shared.String_Elements.Table (Current);
Get_Name_String (Element.Value); Get_Name_String (Element.Value);
if Name_Len /= 0 then if Name_Len /= 0 then
@ -1756,12 +1757,12 @@ package body MLib.Prj is
while Iface /= Nil_String loop while Iface /= Nil_String loop
ALI := ALI :=
File_Name_Type File_Name_Type
(In_Tree.String_Elements.Table (Iface).Value); (In_Tree.Shared.String_Elements.Table (Iface).Value);
Interface_ALIs.Set (ALI, True); Interface_ALIs.Set (ALI, True);
Get_Name_String Get_Name_String
(In_Tree.String_Elements.Table (Iface).Value); (In_Tree.Shared.String_Elements.Table (Iface).Value);
Add_Argument (Name_Buffer (1 .. Name_Len)); Add_Argument (Name_Buffer (1 .. Name_Len));
Iface := In_Tree.String_Elements.Table (Iface).Next; Iface := In_Tree.Shared.String_Elements.Table (Iface).Next;
end loop; end loop;
Iface := For_Project.Lib_Interface_ALIs; Iface := For_Project.Lib_Interface_ALIs;
@ -1775,9 +1776,10 @@ package body MLib.Prj is
while Iface /= Nil_String loop while Iface /= Nil_String loop
ALI := ALI :=
File_Name_Type File_Name_Type
(In_Tree.String_Elements.Table (Iface).Value); (In_Tree.Shared.String_Elements.Table (Iface).Value);
Process (ALI); Process (ALI);
Iface := In_Tree.String_Elements.Table (Iface).Next; Iface :=
In_Tree.Shared.String_Elements.Table (Iface).Next;
end loop; end loop;
end if; end if;
end; end;

163
gcc/ada/prj-conf.adb
View File

@ -101,6 +101,17 @@ package body Prj.Conf is
pragma No_Return (Raise_Invalid_Config); pragma No_Return (Raise_Invalid_Config);
-- Raises exception Invalid_Config with given message -- Raises exception Invalid_Config with given message
procedure Apply_Config_File
(Config_File : Prj.Project_Id;
Project_Tree : Prj.Project_Tree_Ref);
-- Apply the configuration file settings to all the projects in the
-- project tree. The Project_Tree must have been parsed first, and
-- processed through the first phase so that all its projects are known.
--
-- Currently, this will add new attributes and packages in the various
-- projects, so that when the second phase of the processing is performed
-- these attributes are automatically taken into account.
-------------------- --------------------
-- Add_Attributes -- -- Add_Attributes --
-------------------- --------------------
@ -110,6 +121,7 @@ package body Prj.Conf is
Conf_Decl : Declarations; Conf_Decl : Declarations;
User_Decl : in out Declarations) User_Decl : in out Declarations)
is is
Shared : constant Shared_Project_Tree_Data_Access := Project_Tree.Shared;
Conf_Attr_Id : Variable_Id; Conf_Attr_Id : Variable_Id;
Conf_Attr : Variable; Conf_Attr : Variable;
Conf_Array_Id : Array_Id; Conf_Array_Id : Array_Id;
@ -130,10 +142,8 @@ package body Prj.Conf is
Conf_Attr_Id := Conf_Decl.Attributes; Conf_Attr_Id := Conf_Decl.Attributes;
User_Attr_Id := User_Decl.Attributes; User_Attr_Id := User_Decl.Attributes;
while Conf_Attr_Id /= No_Variable loop while Conf_Attr_Id /= No_Variable loop
Conf_Attr := Conf_Attr := Shared.Variable_Elements.Table (Conf_Attr_Id);
Project_Tree.Variable_Elements.Table (Conf_Attr_Id); User_Attr := Shared.Variable_Elements.Table (User_Attr_Id);
User_Attr :=
Project_Tree.Variable_Elements.Table (User_Attr_Id);
if not Conf_Attr.Value.Default then if not Conf_Attr.Value.Default then
if User_Attr.Value.Default then if User_Attr.Value.Default then
@ -142,8 +152,7 @@ package body Prj.Conf is
-- value of the configuration attribute. -- value of the configuration attribute.
User_Attr.Value := Conf_Attr.Value; User_Attr.Value := Conf_Attr.Value;
Project_Tree.Variable_Elements.Table (User_Attr_Id) := Shared.Variable_Elements.Table (User_Attr_Id) := User_Attr;
User_Attr;
elsif User_Attr.Value.Kind = List elsif User_Attr.Value.Kind = List
and then Conf_Attr.Value.Values /= Nil_String and then Conf_Attr.Value.Values /= Nil_String
@ -164,22 +173,20 @@ package body Prj.Conf is
-- Create new list -- Create new list
String_Element_Table.Increment_Last String_Element_Table.Increment_Last
(Project_Tree.String_Elements); (Shared.String_Elements);
New_List := String_Element_Table.Last New_List := String_Element_Table.Last
(Project_Tree.String_Elements); (Shared.String_Elements);
-- Value of attribute is new list -- Value of attribute is new list
User_Attr.Value.Values := New_List; User_Attr.Value.Values := New_List;
Project_Tree.Variable_Elements.Table (User_Attr_Id) := Shared.Variable_Elements.Table (User_Attr_Id) := User_Attr;
User_Attr;
loop loop
-- Get each element of configuration list -- Get each element of configuration list
Conf_Elem := Conf_Elem := Shared.String_Elements.Table (Conf_List);
Project_Tree.String_Elements.Table (Conf_List);
New_Elem := Conf_Elem; New_Elem := Conf_Elem;
Conf_List := Conf_Elem.Next; Conf_List := Conf_Elem.Next;
@ -189,8 +196,7 @@ package body Prj.Conf is
-- first element of user list, and we are done. -- first element of user list, and we are done.
New_Elem.Next := User_List; New_Elem.Next := User_List;
Project_Tree.String_Elements.Table Shared.String_Elements.Table (New_List) := New_Elem;
(New_List) := New_Elem;
exit; exit;
else else
@ -198,12 +204,10 @@ package body Prj.Conf is
-- new list. -- new list.
String_Element_Table.Increment_Last String_Element_Table.Increment_Last
(Project_Tree.String_Elements); (Shared.String_Elements);
New_Elem.Next := New_Elem.Next :=
String_Element_Table.Last String_Element_Table.Last (Shared.String_Elements);
(Project_Tree.String_Elements); Shared.String_Elements.Table (New_List) := New_Elem;
Project_Tree.String_Elements.Table
(New_List) := New_Elem;
New_List := New_Elem.Next; New_List := New_Elem.Next;
end if; end if;
end loop; end loop;
@ -217,11 +221,11 @@ package body Prj.Conf is
Conf_Array_Id := Conf_Decl.Arrays; Conf_Array_Id := Conf_Decl.Arrays;
while Conf_Array_Id /= No_Array loop while Conf_Array_Id /= No_Array loop
Conf_Array := Project_Tree.Arrays.Table (Conf_Array_Id); Conf_Array := Shared.Arrays.Table (Conf_Array_Id);
User_Array_Id := User_Decl.Arrays; User_Array_Id := User_Decl.Arrays;
while User_Array_Id /= No_Array loop while User_Array_Id /= No_Array loop
User_Array := Project_Tree.Arrays.Table (User_Array_Id); User_Array := Shared.Arrays.Table (User_Array_Id);
exit when User_Array.Name = Conf_Array.Name; exit when User_Array.Name = Conf_Array.Name;
User_Array_Id := User_Array.Next; User_Array_Id := User_Array.Next;
end loop; end loop;
@ -230,11 +234,11 @@ package body Prj.Conf is
-- do a shallow copy of the full associative array. -- do a shallow copy of the full associative array.
if User_Array_Id = No_Array then if User_Array_Id = No_Array then
Array_Table.Increment_Last (Project_Tree.Arrays); Array_Table.Increment_Last (Shared.Arrays);
User_Array := Conf_Array; User_Array := Conf_Array;
User_Array.Next := User_Decl.Arrays; User_Array.Next := User_Decl.Arrays;
User_Decl.Arrays := Array_Table.Last (Project_Tree.Arrays); User_Decl.Arrays := Array_Table.Last (Shared.Arrays);
Project_Tree.Arrays.Table (User_Decl.Arrays) := User_Array; Shared.Arrays.Table (User_Decl.Arrays) := User_Array;
else else
-- Otherwise, check each array element -- Otherwise, check each array element
@ -242,12 +246,12 @@ package body Prj.Conf is
Conf_Array_Elem_Id := Conf_Array.Value; Conf_Array_Elem_Id := Conf_Array.Value;
while Conf_Array_Elem_Id /= No_Array_Element loop while Conf_Array_Elem_Id /= No_Array_Element loop
Conf_Array_Elem := Conf_Array_Elem :=
Project_Tree.Array_Elements.Table (Conf_Array_Elem_Id); Shared.Array_Elements.Table (Conf_Array_Elem_Id);
User_Array_Elem_Id := User_Array.Value; User_Array_Elem_Id := User_Array.Value;
while User_Array_Elem_Id /= No_Array_Element loop while User_Array_Elem_Id /= No_Array_Element loop
User_Array_Elem := User_Array_Elem :=
Project_Tree.Array_Elements.Table (User_Array_Elem_Id); Shared.Array_Elements.Table (User_Array_Elem_Id);
exit when User_Array_Elem.Index = Conf_Array_Elem.Index; exit when User_Array_Elem.Index = Conf_Array_Elem.Index;
User_Array_Elem_Id := User_Array_Elem.Next; User_Array_Elem_Id := User_Array_Elem.Next;
end loop; end loop;
@ -257,15 +261,14 @@ package body Prj.Conf is
-- user array. -- user array.
if User_Array_Elem_Id = No_Array_Element then if User_Array_Elem_Id = No_Array_Element then
Array_Element_Table.Increment_Last Array_Element_Table.Increment_Last (Shared.Array_Elements);
(Project_Tree.Array_Elements);
User_Array_Elem := Conf_Array_Elem; User_Array_Elem := Conf_Array_Elem;
User_Array_Elem.Next := User_Array.Value; User_Array_Elem.Next := User_Array.Value;
User_Array.Value := User_Array.Value :=
Array_Element_Table.Last (Project_Tree.Array_Elements); Array_Element_Table.Last (Shared.Array_Elements);
Project_Tree.Array_Elements.Table (User_Array.Value) := Shared.Array_Elements.Table (User_Array.Value) :=
User_Array_Elem; User_Array_Elem;
Project_Tree.Arrays.Table (User_Array_Id) := User_Array; Shared.Arrays.Table (User_Array_Id) := User_Array;
-- Otherwise, if the value is a string list, prepend the -- Otherwise, if the value is a string list, prepend the
-- user array element with the conf array element value. -- user array element with the conf array element value.
@ -283,23 +286,22 @@ package body Prj.Conf is
begin begin
loop loop
Conf_List_Elem := Conf_List_Elem :=
Project_Tree.String_Elements.Table Shared.String_Elements.Table (Conf_List);
(Conf_List);
String_Element_Table.Increment_Last String_Element_Table.Increment_Last
(Project_Tree.String_Elements); (Shared.String_Elements);
Next := Next :=
String_Element_Table.Last String_Element_Table.Last
(Project_Tree.String_Elements); (Shared.String_Elements);
Project_Tree.String_Elements.Table (Next) := Shared.String_Elements.Table (Next) :=
Conf_List_Elem; Conf_List_Elem;
if Previous = Nil_String then if Previous = Nil_String then
User_Array_Elem.Value.Values := Next; User_Array_Elem.Value.Values := Next;
Project_Tree.Array_Elements.Table Shared.Array_Elements.Table
(User_Array_Elem_Id) := User_Array_Elem; (User_Array_Elem_Id) := User_Array_Elem;
else else
Project_Tree.String_Elements.Table Shared.String_Elements.Table
(Previous).Next := Next; (Previous).Next := Next;
end if; end if;
@ -308,8 +310,8 @@ package body Prj.Conf is
Conf_List := Conf_List_Elem.Next; Conf_List := Conf_List_Elem.Next;
if Conf_List = Nil_String then if Conf_List = Nil_String then
Project_Tree.String_Elements.Table Shared.String_Elements.Table (Previous).Next :=
(Previous).Next := Link; Link;
exit; exit;
end if; end if;
end loop; end loop;
@ -454,9 +456,10 @@ package body Prj.Conf is
----------------------- -----------------------
procedure Apply_Config_File procedure Apply_Config_File
(Config_File : Prj.Project_Id; (Config_File : Prj.Project_Id;
Project_Tree : Prj.Project_Tree_Ref) Project_Tree : Prj.Project_Tree_Ref)
is is
Shared : constant Shared_Project_Tree_Data_Access := Project_Tree.Shared;
Conf_Decl : constant Declarations := Config_File.Decl; Conf_Decl : constant Declarations := Config_File.Decl;
Conf_Pack_Id : Package_Id; Conf_Pack_Id : Package_Id;
Conf_Pack : Package_Element; Conf_Pack : Package_Element;
@ -467,47 +470,67 @@ package body Prj.Conf is
Proj : Project_List; Proj : Project_List;
begin begin
Debug_Output ("Applying config file to a project tree");
Proj := Project_Tree.Projects; Proj := Project_Tree.Projects;
while Proj /= null loop while Proj /= null loop
if Proj.Project /= Config_File then if Proj.Project /= Config_File then
User_Decl := Proj.Project.Decl; User_Decl := Proj.Project.Decl;
Add_Attributes Add_Attributes
(Project_Tree => Project_Tree, (Project_Tree => Project_Tree,
Conf_Decl => Conf_Decl, Conf_Decl => Conf_Decl,
User_Decl => User_Decl); User_Decl => User_Decl);
Conf_Pack_Id := Conf_Decl.Packages; Conf_Pack_Id := Conf_Decl.Packages;
while Conf_Pack_Id /= No_Package loop while Conf_Pack_Id /= No_Package loop
Conf_Pack := Project_Tree.Packages.Table (Conf_Pack_Id); Conf_Pack := Shared.Packages.Table (Conf_Pack_Id);
User_Pack_Id := User_Decl.Packages; User_Pack_Id := User_Decl.Packages;
while User_Pack_Id /= No_Package loop while User_Pack_Id /= No_Package loop
User_Pack := Project_Tree.Packages.Table (User_Pack_Id); User_Pack := Shared.Packages.Table (User_Pack_Id);
exit when User_Pack.Name = Conf_Pack.Name; exit when User_Pack.Name = Conf_Pack.Name;
User_Pack_Id := User_Pack.Next; User_Pack_Id := User_Pack.Next;
end loop; end loop;
if User_Pack_Id = No_Package then if User_Pack_Id = No_Package then
Package_Table.Increment_Last (Project_Tree.Packages); Package_Table.Increment_Last (Shared.Packages);
User_Pack := Conf_Pack; User_Pack := Conf_Pack;
User_Pack.Next := User_Decl.Packages; User_Pack.Next := User_Decl.Packages;
User_Decl.Packages := User_Decl.Packages := Package_Table.Last (Shared.Packages);
Package_Table.Last (Project_Tree.Packages); Shared.Packages.Table (User_Decl.Packages) := User_Pack;
Project_Tree.Packages.Table (User_Decl.Packages) :=
User_Pack;
else else
Add_Attributes Add_Attributes
(Project_Tree => Project_Tree, (Project_Tree => Project_Tree,
Conf_Decl => Conf_Pack.Decl, Conf_Decl => Conf_Pack.Decl,
User_Decl => Project_Tree.Packages.Table User_Decl =>
(User_Pack_Id).Decl); Shared.Packages.Table (User_Pack_Id).Decl);
end if; end if;
Conf_Pack_Id := Conf_Pack.Next; Conf_Pack_Id := Conf_Pack.Next;
end loop; end loop;
Proj.Project.Decl := User_Decl; Proj.Project.Decl := User_Decl;
-- For aggregate projects, we need to apply the config to all
-- their aggregated trees as well.
if Proj.Project.Qualifier = Aggregate then
declare
List : Aggregated_Project_List :=
Proj.Project.Aggregated_Projects;
begin
while List /= null loop
Debug_Output
("Recursively apply config to aggregated tree",
List.Project.Name);
Apply_Config_File
(Config_File,
Project_Tree => List.Tree);
List := List.Next;
end loop;
end;
end if;
end if; end if;
Proj := Proj.Next; Proj := Proj.Next;
@ -524,9 +547,10 @@ package body Prj.Conf is
Project_Tree : Prj.Project_Tree_Ref; Project_Tree : Prj.Project_Tree_Ref;
Target : String := "") return Boolean Target : String := "") return Boolean
is is
Shared : constant Shared_Project_Tree_Data_Access := Project_Tree.Shared;
Variable : constant Variable_Value := Variable : constant Variable_Value :=
Value_Of Value_Of
(Name_Target, Config_File.Decl.Attributes, Project_Tree); (Name_Target, Config_File.Decl.Attributes, Shared);
Tgt_Name : Name_Id := No_Name; Tgt_Name : Name_Id := No_Name;
OK : Boolean; OK : Boolean;
@ -585,6 +609,7 @@ package body Prj.Conf is
Automatically_Generated : out Boolean; Automatically_Generated : out Boolean;
On_Load_Config : Config_File_Hook := null) On_Load_Config : Config_File_Hook := null)
is is
Shared : constant Shared_Project_Tree_Data_Access := Project_Tree.Shared;
At_Least_One_Compiler_Command : Boolean := False; At_Least_One_Compiler_Command : Boolean := False;
-- Set to True if at least one attribute Ide'Compiler_Command is -- Set to True if at least one attribute Ide'Compiler_Command is
@ -655,7 +680,7 @@ package body Prj.Conf is
Value_Of Value_Of
(Name_Source_Dirs, (Name_Source_Dirs,
Project.Decl.Attributes, Project.Decl.Attributes,
Project_Tree); Shared);
if Variable = Nil_Variable_Value if Variable = Nil_Variable_Value
or else Variable.Default or else Variable.Default
@ -665,7 +690,7 @@ package body Prj.Conf is
Value_Of Value_Of
(Name_Source_Files, (Name_Source_Files,
Project.Decl.Attributes, Project.Decl.Attributes,
Project_Tree); Shared);
return Variable = Nil_Variable_Value return Variable = Nil_Variable_Value
or else Variable.Default or else Variable.Default
or else Variable.Values /= Nil_String; or else Variable.Values /= Nil_String;
@ -690,10 +715,7 @@ package body Prj.Conf is
-- Hash table to keep the languages used in the project tree -- Hash table to keep the languages used in the project tree
IDE : constant Package_Id := IDE : constant Package_Id :=
Value_Of Value_Of (Name_Ide, Project.Decl.Packages, Shared);
(Name_Ide,
Project.Decl.Packages,
Project_Tree);
Prj_Iter : Project_List; Prj_Iter : Project_List;
List : String_List_Id; List : String_List_Id;
@ -714,7 +736,7 @@ package body Prj.Conf is
Value_Of Value_Of
(Name_Languages, (Name_Languages,
Prj_Iter.Project.Decl.Attributes, Prj_Iter.Project.Decl.Attributes,
Project_Tree); Shared);
if Variable = Nil_Variable_Value if Variable = Nil_Variable_Value
or else Variable.Default or else Variable.Default
@ -730,7 +752,7 @@ package body Prj.Conf is
Value_Of Value_Of
(Name_Languages, (Name_Languages,
Prj_Iter.Project.Extends.Decl.Attributes, Prj_Iter.Project.Extends.Decl.Attributes,
Project_Tree); Shared);
Check_Default := Check_Default :=
Variable /= Nil_Variable_Value Variable /= Nil_Variable_Value
and then Variable.Values = Nil_String; and then Variable.Values = Nil_String;
@ -741,7 +763,7 @@ package body Prj.Conf is
Value_Of Value_Of
(Name_Default_Language, (Name_Default_Language,
Prj_Iter.Project.Decl.Attributes, Prj_Iter.Project.Decl.Attributes,
Project_Tree); Shared);
if Variable /= Nil_Variable_Value if Variable /= Nil_Variable_Value
and then not Variable.Default and then not Variable.Default
@ -765,7 +787,7 @@ package body Prj.Conf is
List := Variable.Values; List := Variable.Values;
while List /= Nil_String loop while List /= Nil_String loop
Elem := Project_Tree.String_Elements.Table (List); Elem := Shared.String_Elements.Table (List);
Get_Name_String (Elem.Value); Get_Name_String (Elem.Value);
To_Lower (Name_Buffer (1 .. Name_Len)); To_Lower (Name_Buffer (1 .. Name_Len));
@ -800,7 +822,7 @@ package body Prj.Conf is
(Name, (Name,
Attribute_Or_Array_Name => Name_Compiler_Command, Attribute_Or_Array_Name => Name_Compiler_Command,
In_Package => IDE, In_Package => IDE,
In_Tree => Project_Tree, Shared => Shared,
Force_Lower_Case_Index => True); Force_Lower_Case_Index => True);
declare declare
@ -857,7 +879,7 @@ package body Prj.Conf is
Value_Of Value_Of
(Name_Object_Dir, (Name_Object_Dir,
Project.Decl.Attributes, Project.Decl.Attributes,
Project_Tree); Shared);
Gprconfig_Path : String_Access; Gprconfig_Path : String_Access;
Success : Boolean; Success : Boolean;
@ -1261,6 +1283,7 @@ package body Prj.Conf is
On_Load_Config : Config_File_Hook := null; On_Load_Config : Config_File_Hook := null;
Reset_Tree : Boolean := True) Reset_Tree : Boolean := True)
is is
Shared : constant Shared_Project_Tree_Data_Access := Project_Tree.Shared;
Main_Config_Project : Project_Id; Main_Config_Project : Project_Id;
Success : Boolean; Success : Boolean;
@ -1289,7 +1312,7 @@ package body Prj.Conf is
Value_Of Value_Of
(Name_Object_Dir, (Name_Object_Dir,
Main_Project.Decl.Attributes, Main_Project.Decl.Attributes,
Project_Tree); Shared);
begin begin
if Obj_Dir = Nil_Variable_Value or else Obj_Dir.Default then if Obj_Dir = Nil_Variable_Value or else Obj_Dir.Default then

11
gcc/ada/prj-conf.ads
View File

@ -162,17 +162,6 @@ package Prj.Conf is
-- processed (and Packages_To_Check is used to indicate which packages -- processed (and Packages_To_Check is used to indicate which packages
-- should be processed) -- should be processed)
procedure Apply_Config_File
(Config_File : Prj.Project_Id;
Project_Tree : Prj.Project_Tree_Ref);
-- Apply the configuration file settings to all the projects in the
-- project tree. The Project_Tree must have been parsed first, and
-- processed through the first phase so that all its projects are known.
--
-- Currently, this will add new attributes and packages in the various
-- projects, so that when the second phase of the processing is performed
-- these attributes are automatically taken into account.
procedure Add_Default_GNAT_Naming_Scheme procedure Add_Default_GNAT_Naming_Scheme
(Config_File : in out Prj.Tree.Project_Node_Id; (Config_File : in out Prj.Tree.Project_Node_Id;
Project_Tree : Prj.Tree.Project_Node_Tree_Ref); Project_Tree : Prj.Tree.Project_Node_Tree_Ref);

135
gcc/ada/prj-env.adb
View File

@ -76,7 +76,7 @@ package body Prj.Env is
procedure Add_To_Path procedure Add_To_Path
(Source_Dirs : String_List_Id; (Source_Dirs : String_List_Id;
In_Tree : Project_Tree_Ref; Shared : Shared_Project_Tree_Data_Access;
Buffer : in out String_Access; Buffer : in out String_Access;
Buffer_Last : in out Natural); Buffer_Last : in out Natural);
-- Add to Ada_Path_Buffer all the source directories in string list -- Add to Ada_Path_Buffer all the source directories in string list
@ -91,7 +91,7 @@ package body Prj.Env is
procedure Add_To_Source_Path procedure Add_To_Source_Path
(Source_Dirs : String_List_Id; (Source_Dirs : String_List_Id;
In_Tree : Project_Tree_Ref; Shared : Shared_Project_Tree_Data_Access;
Source_Paths : in out Source_Path_Table.Instance); Source_Paths : in out Source_Path_Table.Instance);
-- Add to Ada_Path_B all the source directories in string list -- Add to Ada_Path_B all the source directories in string list
-- Source_Dirs, if any. Increment Ada_Path_Length. -- Source_Dirs, if any. Increment Ada_Path_Length.
@ -122,17 +122,25 @@ package body Prj.Env is
Buffer : String_Access; Buffer : String_Access;
Buffer_Last : Natural := 0; Buffer_Last : Natural := 0;
procedure Add (Project : Project_Id; Dummy : in out Boolean); procedure Add
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Dummy : in out Boolean);
-- Add source dirs of Project to the path -- Add source dirs of Project to the path
--------- ---------
-- Add -- -- Add --
--------- ---------
procedure Add (Project : Project_Id; Dummy : in out Boolean) is procedure Add
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Dummy : in out Boolean)
is
pragma Unreferenced (Dummy); pragma Unreferenced (Dummy);
begin begin
Add_To_Path (Project.Source_Dirs, In_Tree, Buffer, Buffer_Last); Add_To_Path
(Project.Source_Dirs, In_Tree.Shared, Buffer, Buffer_Last);
end Add; end Add;
procedure For_All_Projects is procedure For_All_Projects is
@ -150,7 +158,8 @@ package body Prj.Env is
if Project.Ada_Include_Path = null then if Project.Ada_Include_Path = null then
Buffer := new String (1 .. 4096); Buffer := new String (1 .. 4096);
For_All_Projects (Project, Dummy); For_All_Projects
(Project, In_Tree, Dummy, Include_Aggregated => True);
Project.Ada_Include_Path := new String'(Buffer (1 .. Buffer_Last)); Project.Ada_Include_Path := new String'(Buffer (1 .. Buffer_Last));
Free (Buffer); Free (Buffer);
end if; end if;
@ -159,7 +168,8 @@ package body Prj.Env is
else else
Buffer := new String (1 .. 4096); Buffer := new String (1 .. 4096);
Add_To_Path (Project.Source_Dirs, In_Tree, Buffer, Buffer_Last); Add_To_Path
(Project.Source_Dirs, In_Tree.Shared, Buffer, Buffer_Last);
declare declare
Result : constant String := Buffer (1 .. Buffer_Last); Result : constant String := Buffer (1 .. Buffer_Last);
@ -176,20 +186,28 @@ package body Prj.Env is
function Ada_Objects_Path function Ada_Objects_Path
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref;
Including_Libraries : Boolean := True) return String_Access Including_Libraries : Boolean := True) return String_Access
is is
Buffer : String_Access; Buffer : String_Access;
Buffer_Last : Natural := 0; Buffer_Last : Natural := 0;
procedure Add (Project : Project_Id; Dummy : in out Boolean); procedure Add
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Dummy : in out Boolean);
-- Add all the object directories of a project to the path -- Add all the object directories of a project to the path
--------- ---------
-- Add -- -- Add --
--------- ---------
procedure Add (Project : Project_Id; Dummy : in out Boolean) is procedure Add
pragma Unreferenced (Dummy); (Project : Project_Id;
In_Tree : Project_Tree_Ref;
Dummy : in out Boolean)
is
pragma Unreferenced (Dummy, In_Tree);
Path : constant Path_Name_Type := Path : constant Path_Name_Type :=
Get_Object_Directory Get_Object_Directory
(Project, (Project,
@ -214,7 +232,7 @@ package body Prj.Env is
if Project.Ada_Objects_Path = null then if Project.Ada_Objects_Path = null then
Buffer := new String (1 .. 4096); Buffer := new String (1 .. 4096);
For_All_Projects (Project, Dummy); For_All_Projects (Project, In_Tree, Dummy);
Project.Ada_Objects_Path := new String'(Buffer (1 .. Buffer_Last)); Project.Ada_Objects_Path := new String'(Buffer (1 .. Buffer_Last));
Free (Buffer); Free (Buffer);
@ -291,7 +309,7 @@ package body Prj.Env is
procedure Add_To_Path procedure Add_To_Path
(Source_Dirs : String_List_Id; (Source_Dirs : String_List_Id;
In_Tree : Project_Tree_Ref; Shared : Shared_Project_Tree_Data_Access;
Buffer : in out String_Access; Buffer : in out String_Access;
Buffer_Last : in out Natural) Buffer_Last : in out Natural)
is is
@ -299,7 +317,7 @@ package body Prj.Env is
Source_Dir : String_Element; Source_Dir : String_Element;
begin begin
while Current /= Nil_String loop while Current /= Nil_String loop
Source_Dir := In_Tree.String_Elements.Table (Current); Source_Dir := Shared.String_Elements.Table (Current);
Add_To_Path (Get_Name_String (Source_Dir.Display_Value), Add_To_Path (Get_Name_String (Source_Dir.Display_Value),
Buffer, Buffer_Last); Buffer, Buffer_Last);
Current := Source_Dir.Next; Current := Source_Dir.Next;
@ -395,7 +413,7 @@ package body Prj.Env is
procedure Add_To_Source_Path procedure Add_To_Source_Path
(Source_Dirs : String_List_Id; (Source_Dirs : String_List_Id;
In_Tree : Project_Tree_Ref; Shared : Shared_Project_Tree_Data_Access;
Source_Paths : in out Source_Path_Table.Instance) Source_Paths : in out Source_Path_Table.Instance)
is is
Current : String_List_Id := Source_Dirs; Current : String_List_Id := Source_Dirs;
@ -406,7 +424,7 @@ package body Prj.Env is
-- Add each source directory -- Add each source directory
while Current /= Nil_String loop while Current /= Nil_String loop
Source_Dir := In_Tree.String_Elements.Table (Current); Source_Dir := Shared.String_Elements.Table (Current);
Add_It := True; Add_It := True;
-- Check if the source directory is already in the table -- Check if the source directory is already in the table
@ -461,7 +479,10 @@ package body Prj.Env is
Iter : Source_Iterator; Iter : Source_Iterator;
Source : Source_Id; Source : Source_Id;
procedure Check (Project : Project_Id; State : in out Integer); procedure Check
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
State : in out Integer);
-- Recursive procedure that put in the config pragmas file any non -- Recursive procedure that put in the config pragmas file any non
-- standard naming schemes, if it is not already in the file, then call -- standard naming schemes, if it is not already in the file, then call
-- itself for any imported project. -- itself for any imported project.
@ -482,23 +503,24 @@ package body Prj.Env is
-- Check -- -- Check --
----------- -----------
procedure Check (Project : Project_Id; State : in out Integer) is procedure Check
pragma Unreferenced (State); (Project : Project_Id;
In_Tree : Project_Tree_Ref;
State : in out Integer)
is
pragma Unreferenced (State, In_Tree);
Lang : constant Language_Ptr := Lang : constant Language_Ptr :=
Get_Language_From_Name (Project, "ada"); Get_Language_From_Name (Project, "ada");
Naming : Lang_Naming_Data; Naming : Lang_Naming_Data;
begin begin
if Current_Verbosity = High then if Current_Verbosity = High then
Write_Str ("Checking project file """); Debug_Output ("Checking project file:", Project.Name);
Write_Str (Namet.Get_Name_String (Project.Name));
Write_Str (""".");
Write_Eol;
end if; end if;
if Lang = null then if Lang = null then
if Current_Verbosity = High then if Current_Verbosity = High then
Write_Line (" Languages does not contain Ada, nothing to do"); Debug_Output ("Languages does not contain Ada, nothing to do");
end if; end if;
return; return;
@ -665,7 +687,8 @@ package body Prj.Env is
-- Check the naming schemes -- Check the naming schemes
Check_Imported_Projects (For_Project, Dummy, Imported_First => False); Check_Imported_Projects
(For_Project, In_Tree, Dummy, Imported_First => False);
-- Visit all the files and process those that need an SFN pragma -- Visit all the files and process those that need an SFN pragma
@ -767,7 +790,10 @@ package body Prj.Env is
procedure Put_Name_Buffer; procedure Put_Name_Buffer;
-- Put the line contained in the Name_Buffer in the global buffer -- Put the line contained in the Name_Buffer in the global buffer
procedure Process (Project : Project_Id; State : in out Integer); procedure Process
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
State : in out Integer);
-- Generate the mapping file for Project (not recursively) -- Generate the mapping file for Project (not recursively)
--------------------- ---------------------
@ -789,7 +815,11 @@ package body Prj.Env is
-- Process -- -- Process --
------------- -------------
procedure Process (Project : Project_Id; State : in out Integer) is procedure Process
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
State : in out Integer)
is
pragma Unreferenced (State); pragma Unreferenced (State);
Source : Source_Id; Source : Source_Id;
Suffix : File_Name_Type; Suffix : File_Name_Type;
@ -874,7 +904,7 @@ package body Prj.Env is
Debug_Increase_Indent ("Create mapping file ", Name_Id (Name)); Debug_Increase_Indent ("Create mapping file ", Name_Id (Name));
end if; end if;
For_Every_Imported_Project (Project, Dummy); For_Every_Imported_Project (Project, In_Tree, Dummy);
declare declare
Last : Natural; Last : Natural;
@ -1174,16 +1204,26 @@ package body Prj.Env is
-- For_All_Object_Dirs -- -- For_All_Object_Dirs --
------------------------- -------------------------
procedure For_All_Object_Dirs (Project : Project_Id) is procedure For_All_Object_Dirs
procedure For_Project (Prj : Project_Id; Dummy : in out Integer); (Project : Project_Id;
Tree : Project_Tree_Ref)
is
procedure For_Project
(Prj : Project_Id;
Tree : Project_Tree_Ref;
Dummy : in out Integer);
-- Get all object directories of Prj -- Get all object directories of Prj
----------------- -----------------
-- For_Project -- -- For_Project --
----------------- -----------------
procedure For_Project (Prj : Project_Id; Dummy : in out Integer) is procedure For_Project
pragma Unreferenced (Dummy); (Prj : Project_Id;
Tree : Project_Tree_Ref;
Dummy : in out Integer)
is
pragma Unreferenced (Dummy, Tree);
begin begin
-- ??? Set_Ada_Paths has a different behavior for library project -- ??? Set_Ada_Paths has a different behavior for library project
-- files, should we have the same ? -- files, should we have the same ?
@ -1201,7 +1241,7 @@ package body Prj.Env is
-- Start of processing for For_All_Object_Dirs -- Start of processing for For_All_Object_Dirs
begin begin
Get_Object_Dirs (Project, Dummy); Get_Object_Dirs (Project, Tree, Dummy);
end For_All_Object_Dirs; end For_All_Object_Dirs;
------------------------- -------------------------
@ -1212,14 +1252,21 @@ package body Prj.Env is
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref) In_Tree : Project_Tree_Ref)
is is
procedure For_Project (Prj : Project_Id; Dummy : in out Integer); procedure For_Project
(Prj : Project_Id;
In_Tree : Project_Tree_Ref;
Dummy : in out Integer);
-- Get all object directories of Prj -- Get all object directories of Prj
----------------- -----------------
-- For_Project -- -- For_Project --
----------------- -----------------
procedure For_Project (Prj : Project_Id; Dummy : in out Integer) is procedure For_Project
(Prj : Project_Id;
In_Tree : Project_Tree_Ref;
Dummy : in out Integer)
is
pragma Unreferenced (Dummy); pragma Unreferenced (Dummy);
Current : String_List_Id := Prj.Source_Dirs; Current : String_List_Id := Prj.Source_Dirs;
The_String : String_Element; The_String : String_Element;
@ -1230,7 +1277,7 @@ package body Prj.Env is
if Has_Ada_Sources (Project) then if Has_Ada_Sources (Project) then
while Current /= Nil_String loop while Current /= Nil_String loop
The_String := In_Tree.String_Elements.Table (Current); The_String := In_Tree.Shared.String_Elements.Table (Current);
Action (Get_Name_String (The_String.Display_Value)); Action (Get_Name_String (The_String.Display_Value));
Current := The_String.Next; Current := The_String.Next;
end loop; end loop;
@ -1244,7 +1291,7 @@ package body Prj.Env is
-- Start of processing for For_All_Source_Dirs -- Start of processing for For_All_Source_Dirs
begin begin
Get_Source_Dirs (Project, Dummy); Get_Source_Dirs (Project, In_Tree, Dummy);
end For_All_Source_Dirs; end For_All_Source_Dirs;
------------------- -------------------
@ -1541,7 +1588,10 @@ package body Prj.Env is
Buffer : String_Access := new String (1 .. Buffer_Initial); Buffer : String_Access := new String (1 .. Buffer_Initial);
Buffer_Last : Natural := 0; Buffer_Last : Natural := 0;
procedure Recursive_Add (Project : Project_Id; Dummy : in out Boolean); procedure Recursive_Add
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Dummy : in out Boolean);
-- Recursive procedure to add the source/object paths of extended/ -- Recursive procedure to add the source/object paths of extended/
-- imported projects. -- imported projects.
@ -1549,7 +1599,11 @@ package body Prj.Env is
-- Recursive_Add -- -- Recursive_Add --
------------------- -------------------
procedure Recursive_Add (Project : Project_Id; Dummy : in out Boolean) is procedure Recursive_Add
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Dummy : in out Boolean)
is
pragma Unreferenced (Dummy); pragma Unreferenced (Dummy);
Path : Path_Name_Type; Path : Path_Name_Type;
@ -1563,7 +1617,8 @@ package body Prj.Env is
-- Ada sources. -- Ada sources.
if Has_Ada_Sources (Project) then if Has_Ada_Sources (Project) then
Add_To_Source_Path (Project.Source_Dirs, In_Tree, Source_Paths); Add_To_Source_Path
(Project.Source_Dirs, In_Tree.Shared, Source_Paths);
end if; end if;
end if; end if;
@ -1621,7 +1676,7 @@ package body Prj.Env is
-- then call the recursive procedure Add for Project. -- then call the recursive procedure Add for Project.
if Process_Source_Dirs or Process_Object_Dirs then if Process_Source_Dirs or Process_Object_Dirs then
For_All_Projects (Project, Dummy); For_All_Projects (Project, In_Tree, Dummy);
end if; end if;
-- Write and close any file that has been created. Source_FD is not set -- Write and close any file that has been created. Source_FD is not set

5
gcc/ada/prj-env.ads
View File

@ -88,6 +88,7 @@ package Prj.Env is
function Ada_Objects_Path function Ada_Objects_Path
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref;
Including_Libraries : Boolean := True) return String_Access; Including_Libraries : Boolean := True) return String_Access;
-- Get the ADA_OBJECTS_PATH of a Project file. For the first call, compute -- Get the ADA_OBJECTS_PATH of a Project file. For the first call, compute
-- it and cache it. When Including_Libraries is False, do not include the -- it and cache it. When Including_Libraries is False, do not include the
@ -149,7 +150,9 @@ package Prj.Env is
generic generic
with procedure Action (Path : String); with procedure Action (Path : String);
procedure For_All_Object_Dirs (Project : Project_Id); procedure For_All_Object_Dirs
(Project : Project_Id;
Tree : Project_Tree_Ref);
-- Iterate through all the object directories of a project, including those -- Iterate through all the object directories of a project, including those
-- of imported or modified projects. -- of imported or modified projects.

365
gcc/ada/prj-nmsc.adb
View File

File diff suppressed because it is too large Load Diff

584
gcc/ada/prj-proc.adb
View File

File diff suppressed because it is too large Load Diff

2
gcc/ada/prj-proc.ads
View File

@ -72,7 +72,7 @@ package Prj.Proc is
From_Project_Node : Project_Node_Id; From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref; From_Project_Node_Tree : Project_Node_Tree_Ref;
Env : in out Prj.Tree.Environment; Env : in out Prj.Tree.Environment;
Reset_Tree : Boolean := True); Reset_Tree : Boolean := True);
-- Performs the two phases of the processing -- Performs the two phases of the processing
end Prj.Proc; end Prj.Proc;

95
gcc/ada/prj-util.adb
View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2001-2010, Free Software Foundation, Inc. -- -- Copyright (C) 2001-2011, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
@ -129,7 +129,7 @@ package body Prj.Util is
procedure Duplicate procedure Duplicate
(This : in out Name_List_Index; (This : in out Name_List_Index;
In_Tree : Project_Tree_Ref) Shared : Shared_Project_Tree_Data_Access)
is is
Old_Current : Name_List_Index; Old_Current : Name_List_Index;
New_Current : Name_List_Index; New_Current : Name_List_Index;
@ -137,20 +137,20 @@ package body Prj.Util is
begin begin
if This /= No_Name_List then if This /= No_Name_List then
Old_Current := This; Old_Current := This;
Name_List_Table.Increment_Last (In_Tree.Name_Lists); Name_List_Table.Increment_Last (Shared.Name_Lists);
New_Current := Name_List_Table.Last (In_Tree.Name_Lists); New_Current := Name_List_Table.Last (Shared.Name_Lists);
This := New_Current; This := New_Current;
In_Tree.Name_Lists.Table (New_Current) := Shared.Name_Lists.Table (New_Current) :=
(In_Tree.Name_Lists.Table (Old_Current).Name, No_Name_List); (Shared.Name_Lists.Table (Old_Current).Name, No_Name_List);
loop loop
Old_Current := In_Tree.Name_Lists.Table (Old_Current).Next; Old_Current := Shared.Name_Lists.Table (Old_Current).Next;
exit when Old_Current = No_Name_List; exit when Old_Current = No_Name_List;
In_Tree.Name_Lists.Table (New_Current).Next := New_Current + 1; Shared.Name_Lists.Table (New_Current).Next := New_Current + 1;
Name_List_Table.Increment_Last (In_Tree.Name_Lists); Name_List_Table.Increment_Last (Shared.Name_Lists);
New_Current := New_Current + 1; New_Current := New_Current + 1;
In_Tree.Name_Lists.Table (New_Current) := Shared.Name_Lists.Table (New_Current) :=
(In_Tree.Name_Lists.Table (Old_Current).Name, No_Name_List); (Shared.Name_Lists.Table (Old_Current).Name, No_Name_List);
end loop; end loop;
end if; end if;
end Duplicate; end Duplicate;
@ -174,7 +174,7 @@ package body Prj.Util is
function Executable_Of function Executable_Of
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref; Shared : Shared_Project_Tree_Data_Access;
Main : File_Name_Type; Main : File_Name_Type;
Index : Int; Index : Int;
Ada_Main : Boolean := True; Ada_Main : Boolean := True;
@ -189,7 +189,7 @@ package body Prj.Util is
Prj.Util.Value_Of Prj.Util.Value_Of
(Name => Name_Builder, (Name => Name_Builder,
In_Packages => The_Packages, In_Packages => The_Packages,
In_Tree => In_Tree); Shared => Shared);
Executable : Variable_Value := Executable : Variable_Value :=
Prj.Util.Value_Of Prj.Util.Value_Of
@ -197,7 +197,7 @@ package body Prj.Util is
Index => Index, Index => Index,
Attribute_Or_Array_Name => Name_Executable, Attribute_Or_Array_Name => Name_Executable,
In_Package => Builder_Package, In_Package => Builder_Package,
In_Tree => In_Tree); Shared => Shared);
Lang : Language_Ptr; Lang : Language_Ptr;
@ -266,8 +266,8 @@ package body Prj.Util is
Prj.Util.Value_Of Prj.Util.Value_Of
(Variable_Name => Name_Executable_Suffix, (Variable_Name => Name_Executable_Suffix,
In_Variables => In_Variables =>
In_Tree.Packages.Table (Builder_Package).Decl.Attributes, Shared.Packages.Table (Builder_Package).Decl.Attributes,
In_Tree => In_Tree); Shared => Shared);
if Suffix_From_Project /= Nil_Variable_Value if Suffix_From_Project /= Nil_Variable_Value
and then Suffix_From_Project.Value /= No_Name and then Suffix_From_Project.Value /= No_Name
@ -340,7 +340,7 @@ package body Prj.Util is
Index => 0, Index => 0,
Attribute_Or_Array_Name => Name_Executable, Attribute_Or_Array_Name => Name_Executable,
In_Package => Builder_Package, In_Package => Builder_Package,
In_Tree => In_Tree); Shared => Shared);
end if; end if;
end; end;
end if; end if;
@ -554,24 +554,26 @@ package body Prj.Util is
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Lower_Case : Boolean := False) Lower_Case : Boolean := False)
is is
Shared : constant Shared_Project_Tree_Data_Access := In_Tree.Shared;
Current_Name : Name_List_Index; Current_Name : Name_List_Index;
List : String_List_Id; List : String_List_Id;
Element : String_Element; Element : String_Element;
Last : Name_List_Index := Last : Name_List_Index :=
Name_List_Table.Last (In_Tree.Name_Lists); Name_List_Table.Last (Shared.Name_Lists);
Value : Name_Id; Value : Name_Id;
begin begin
Current_Name := Into_List; Current_Name := Into_List;
while Current_Name /= No_Name_List while Current_Name /= No_Name_List
and then In_Tree.Name_Lists.Table (Current_Name).Next /= No_Name_List and then Shared.Name_Lists.Table (Current_Name).Next /= No_Name_List
loop loop
Current_Name := In_Tree.Name_Lists.Table (Current_Name).Next; Current_Name := Shared.Name_Lists.Table (Current_Name).Next;
end loop; end loop;
List := From_List; List := From_List;
while List /= Nil_String loop while List /= Nil_String loop
Element := In_Tree.String_Elements.Table (List); Element := Shared.String_Elements.Table (List);
Value := Element.Value; Value := Element.Value;
if Lower_Case then if Lower_Case then
@ -581,15 +583,14 @@ package body Prj.Util is
end if; end if;
Name_List_Table.Append Name_List_Table.Append
(In_Tree.Name_Lists, (Name => Value, Next => No_Name_List)); (Shared.Name_Lists, (Name => Value, Next => No_Name_List));
Last := Last + 1; Last := Last + 1;
if Current_Name = No_Name_List then if Current_Name = No_Name_List then
Into_List := Last; Into_List := Last;
else else
In_Tree.Name_Lists.Table (Current_Name).Next := Last; Shared.Name_Lists.Table (Current_Name).Next := Last;
end if; end if;
Current_Name := Last; Current_Name := Last;
@ -808,8 +809,9 @@ package body Prj.Util is
function Value_Of function Value_Of
(Index : Name_Id; (Index : Name_Id;
In_Array : Array_Element_Id; In_Array : Array_Element_Id;
In_Tree : Project_Tree_Ref) return Name_Id Shared : Shared_Project_Tree_Data_Access) return Name_Id
is is
Current : Array_Element_Id; Current : Array_Element_Id;
Element : Array_Element; Element : Array_Element;
Real_Index : Name_Id := Index; Real_Index : Name_Id := Index;
@ -821,7 +823,7 @@ package body Prj.Util is
return No_Name; return No_Name;
end if; end if;
Element := In_Tree.Array_Elements.Table (Current); Element := Shared.Array_Elements.Table (Current);
if not Element.Index_Case_Sensitive then if not Element.Index_Case_Sensitive then
Get_Name_String (Index); Get_Name_String (Index);
@ -830,7 +832,7 @@ package body Prj.Util is
end if; end if;
while Current /= No_Array_Element loop while Current /= No_Array_Element loop
Element := In_Tree.Array_Elements.Table (Current); Element := Shared.Array_Elements.Table (Current);
if Real_Index = Element.Index then if Real_Index = Element.Index then
exit when Element.Value.Kind /= Single; exit when Element.Value.Kind /= Single;
@ -848,7 +850,7 @@ package body Prj.Util is
(Index : Name_Id; (Index : Name_Id;
Src_Index : Int := 0; Src_Index : Int := 0;
In_Array : Array_Element_Id; In_Array : Array_Element_Id;
In_Tree : Project_Tree_Ref; Shared : Shared_Project_Tree_Data_Access;
Force_Lower_Case_Index : Boolean := False; Force_Lower_Case_Index : Boolean := False;
Allow_Wildcards : Boolean := False) return Variable_Value Allow_Wildcards : Boolean := False) return Variable_Value
is is
@ -864,7 +866,7 @@ package body Prj.Util is
return Nil_Variable_Value; return Nil_Variable_Value;
end if; end if;
Element := In_Tree.Array_Elements.Table (Current); Element := Shared.Array_Elements.Table (Current);
Real_Index_1 := Index; Real_Index_1 := Index;
@ -877,7 +879,7 @@ package body Prj.Util is
end if; end if;
while Current /= No_Array_Element loop while Current /= No_Array_Element loop
Element := In_Tree.Array_Elements.Table (Current); Element := Shared.Array_Elements.Table (Current);
Real_Index_2 := Element.Index; Real_Index_2 := Element.Index;
if not Element.Index_Case_Sensitive if not Element.Index_Case_Sensitive
@ -912,7 +914,7 @@ package body Prj.Util is
Index : Int := 0; Index : Int := 0;
Attribute_Or_Array_Name : Name_Id; Attribute_Or_Array_Name : Name_Id;
In_Package : Package_Id; In_Package : Package_Id;
In_Tree : Project_Tree_Ref; Shared : Shared_Project_Tree_Data_Access;
Force_Lower_Case_Index : Boolean := False; Force_Lower_Case_Index : Boolean := False;
Allow_Wildcards : Boolean := False) return Variable_Value Allow_Wildcards : Boolean := False) return Variable_Value
is is
@ -927,14 +929,14 @@ package body Prj.Util is
The_Array := The_Array :=
Value_Of Value_Of
(Name => Attribute_Or_Array_Name, (Name => Attribute_Or_Array_Name,
In_Arrays => In_Tree.Packages.Table (In_Package).Decl.Arrays, In_Arrays => Shared.Packages.Table (In_Package).Decl.Arrays,
In_Tree => In_Tree); Shared => Shared);
The_Attribute := The_Attribute :=
Value_Of Value_Of
(Index => Name, (Index => Name,
Src_Index => Index, Src_Index => Index,
In_Array => The_Array, In_Array => The_Array,
In_Tree => In_Tree, Shared => Shared,
Force_Lower_Case_Index => Force_Lower_Case_Index, Force_Lower_Case_Index => Force_Lower_Case_Index,
Allow_Wildcards => Allow_Wildcards); Allow_Wildcards => Allow_Wildcards);
@ -944,9 +946,9 @@ package body Prj.Util is
The_Attribute := The_Attribute :=
Value_Of Value_Of
(Variable_Name => Attribute_Or_Array_Name, (Variable_Name => Attribute_Or_Array_Name,
In_Variables => In_Tree.Packages.Table In_Variables => Shared.Packages.Table
(In_Package).Decl.Attributes, (In_Package).Decl.Attributes,
In_Tree => In_Tree); Shared => Shared);
end if; end if;
end if; end if;
@ -957,7 +959,7 @@ package body Prj.Util is
(Index : Name_Id; (Index : Name_Id;
In_Array : Name_Id; In_Array : Name_Id;
In_Arrays : Array_Id; In_Arrays : Array_Id;
In_Tree : Project_Tree_Ref) return Name_Id Shared : Shared_Project_Tree_Data_Access) return Name_Id
is is
Current : Array_Id; Current : Array_Id;
The_Array : Array_Data; The_Array : Array_Data;
@ -965,10 +967,10 @@ package body Prj.Util is
begin begin
Current := In_Arrays; Current := In_Arrays;
while Current /= No_Array loop while Current /= No_Array loop
The_Array := In_Tree.Arrays.Table (Current); The_Array := Shared.Arrays.Table (Current);
if The_Array.Name = In_Array then if The_Array.Name = In_Array then
return Value_Of return Value_Of
(Index, In_Array => The_Array.Value, In_Tree => In_Tree); (Index, In_Array => The_Array.Value, Shared => Shared);
else else
Current := The_Array.Next; Current := The_Array.Next;
end if; end if;
@ -980,7 +982,7 @@ package body Prj.Util is
function Value_Of function Value_Of
(Name : Name_Id; (Name : Name_Id;
In_Arrays : Array_Id; In_Arrays : Array_Id;
In_Tree : Project_Tree_Ref) return Array_Element_Id Shared : Shared_Project_Tree_Data_Access) return Array_Element_Id
is is
Current : Array_Id; Current : Array_Id;
The_Array : Array_Data; The_Array : Array_Data;
@ -988,7 +990,7 @@ package body Prj.Util is
begin begin
Current := In_Arrays; Current := In_Arrays;
while Current /= No_Array loop while Current /= No_Array loop
The_Array := In_Tree.Arrays.Table (Current); The_Array := Shared.Arrays.Table (Current);
if The_Array.Name = Name then if The_Array.Name = Name then
return The_Array.Value; return The_Array.Value;
@ -1003,7 +1005,7 @@ package body Prj.Util is
function Value_Of function Value_Of
(Name : Name_Id; (Name : Name_Id;
In_Packages : Package_Id; In_Packages : Package_Id;
In_Tree : Project_Tree_Ref) return Package_Id Shared : Shared_Project_Tree_Data_Access) return Package_Id
is is
Current : Package_Id; Current : Package_Id;
The_Package : Package_Element; The_Package : Package_Element;
@ -1011,7 +1013,7 @@ package body Prj.Util is
begin begin
Current := In_Packages; Current := In_Packages;
while Current /= No_Package loop while Current /= No_Package loop
The_Package := In_Tree.Packages.Table (Current); The_Package := Shared.Packages.Table (Current);
exit when The_Package.Name /= No_Name exit when The_Package.Name /= No_Name
and then The_Package.Name = Name; and then The_Package.Name = Name;
Current := The_Package.Next; Current := The_Package.Next;
@ -1023,7 +1025,7 @@ package body Prj.Util is
function Value_Of function Value_Of
(Variable_Name : Name_Id; (Variable_Name : Name_Id;
In_Variables : Variable_Id; In_Variables : Variable_Id;
In_Tree : Project_Tree_Ref) return Variable_Value Shared : Shared_Project_Tree_Data_Access) return Variable_Value
is is
Current : Variable_Id; Current : Variable_Id;
The_Variable : Variable; The_Variable : Variable;
@ -1031,8 +1033,7 @@ package body Prj.Util is
begin begin
Current := In_Variables; Current := In_Variables;
while Current /= No_Variable loop while Current /= No_Variable loop
The_Variable := The_Variable := Shared.Variable_Elements.Table (Current);
In_Tree.Variable_Elements.Table (Current);
if Variable_Name = The_Variable.Name then if Variable_Name = The_Variable.Name then
return The_Variable.Value; return The_Variable.Value;

20
gcc/ada/prj-util.ads
View File

@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2001-2010, Free Software Foundation, Inc. -- -- Copyright (C) 2001-2011, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
@ -29,7 +29,7 @@ package Prj.Util is
function Executable_Of function Executable_Of
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref; Shared : Shared_Project_Tree_Data_Access;
Main : File_Name_Type; Main : File_Name_Type;
Index : Int; Index : Int;
Ada_Main : Boolean := True; Ada_Main : Boolean := True;
@ -61,7 +61,7 @@ package Prj.Util is
procedure Duplicate procedure Duplicate
(This : in out Name_List_Index; (This : in out Name_List_Index;
In_Tree : Project_Tree_Ref); Shared : Shared_Project_Tree_Data_Access);
-- Duplicate a name list -- Duplicate a name list
function Value_Of function Value_Of
@ -73,7 +73,7 @@ package Prj.Util is
function Value_Of function Value_Of
(Index : Name_Id; (Index : Name_Id;
In_Array : Array_Element_Id; In_Array : Array_Element_Id;
In_Tree : Project_Tree_Ref) return Name_Id; Shared : Shared_Project_Tree_Data_Access) return Name_Id;
-- Get a single string array component. Returns No_Name if there is no -- Get a single string array component. Returns No_Name if there is no
-- component Index, if In_Array is null, or if the component is a String -- component Index, if In_Array is null, or if the component is a String
-- list. Depending on the attribute (only attributes may be associative -- list. Depending on the attribute (only attributes may be associative
@ -85,7 +85,7 @@ package Prj.Util is
(Index : Name_Id; (Index : Name_Id;
Src_Index : Int := 0; Src_Index : Int := 0;
In_Array : Array_Element_Id; In_Array : Array_Element_Id;
In_Tree : Project_Tree_Ref; Shared : Shared_Project_Tree_Data_Access;
Force_Lower_Case_Index : Boolean := False; Force_Lower_Case_Index : Boolean := False;
Allow_Wildcards : Boolean := False) return Variable_Value; Allow_Wildcards : Boolean := False) return Variable_Value;
-- Get a string array component (single String or String list). Returns -- Get a string array component (single String or String list). Returns
@ -101,7 +101,7 @@ package Prj.Util is
Index : Int := 0; Index : Int := 0;
Attribute_Or_Array_Name : Name_Id; Attribute_Or_Array_Name : Name_Id;
In_Package : Package_Id; In_Package : Package_Id;
In_Tree : Project_Tree_Ref; Shared : Shared_Project_Tree_Data_Access;
Force_Lower_Case_Index : Boolean := False; Force_Lower_Case_Index : Boolean := False;
Allow_Wildcards : Boolean := False) return Variable_Value; Allow_Wildcards : Boolean := False) return Variable_Value;
-- In a specific package: -- In a specific package:
@ -117,7 +117,7 @@ package Prj.Util is
(Index : Name_Id; (Index : Name_Id;
In_Array : Name_Id; In_Array : Name_Id;
In_Arrays : Array_Id; In_Arrays : Array_Id;
In_Tree : Project_Tree_Ref) return Name_Id; Shared : Shared_Project_Tree_Data_Access) return Name_Id;
-- Get a string array component in an array of an array list. Returns -- Get a string array component in an array of an array list. Returns
-- No_Name if there is no component Index, if In_Arrays is null, if -- No_Name if there is no component Index, if In_Arrays is null, if
-- In_Array is not found in In_Arrays or if the component is a String list. -- In_Array is not found in In_Arrays or if the component is a String list.
@ -125,7 +125,7 @@ package Prj.Util is
function Value_Of function Value_Of
(Name : Name_Id; (Name : Name_Id;
In_Arrays : Array_Id; In_Arrays : Array_Id;
In_Tree : Project_Tree_Ref) return Array_Element_Id; Shared : Shared_Project_Tree_Data_Access) return Array_Element_Id;
-- Returns a specified array in an array list. Returns No_Array_Element -- Returns a specified array in an array list. Returns No_Array_Element
-- if In_Arrays is null or if Name is not the name of an array in -- if In_Arrays is null or if Name is not the name of an array in
-- In_Arrays. The caller must ensure that Name is in lower case. -- In_Arrays. The caller must ensure that Name is in lower case.
@ -133,7 +133,7 @@ package Prj.Util is
function Value_Of function Value_Of
(Name : Name_Id; (Name : Name_Id;
In_Packages : Package_Id; In_Packages : Package_Id;
In_Tree : Project_Tree_Ref) return Package_Id; Shared : Shared_Project_Tree_Data_Access) return Package_Id;
-- Returns a specified package in a package list. Returns No_Package -- Returns a specified package in a package list. Returns No_Package
-- if In_Packages is null or if Name is not the name of a package in -- if In_Packages is null or if Name is not the name of a package in
-- Package_List. The caller must ensure that Name is in lower case. -- Package_List. The caller must ensure that Name is in lower case.
@ -141,7 +141,7 @@ package Prj.Util is
function Value_Of function Value_Of
(Variable_Name : Name_Id; (Variable_Name : Name_Id;
In_Variables : Variable_Id; In_Variables : Variable_Id;
In_Tree : Project_Tree_Ref) return Variable_Value; Shared : Shared_Project_Tree_Data_Access) return Variable_Value;
-- Returns a specified variable in a variable list. Returns null if -- Returns a specified variable in a variable list. Returns null if
-- In_Variables is null or if Variable_Name is not the name of a -- In_Variables is null or if Variable_Name is not the name of a
-- variable in In_Variables. Caller must ensure that Name is lower case. -- variable in In_Variables. Caller must ensure that Name is lower case.

110
gcc/ada/prj.adb
View File

@ -404,6 +404,7 @@ package body Prj is
procedure For_Every_Project_Imported procedure For_Every_Project_Imported
(By : Project_Id; (By : Project_Id;
Tree : Project_Tree_Ref;
With_State : in out State; With_State : in out State;
Include_Aggregated : Boolean := True; Include_Aggregated : Boolean := True;
Imported_First : Boolean := False) Imported_First : Boolean := False)
@ -411,7 +412,8 @@ package body Prj is
use Project_Boolean_Htable; use Project_Boolean_Htable;
Seen : Project_Boolean_Htable.Instance := Project_Boolean_Htable.Nil; Seen : Project_Boolean_Htable.Instance := Project_Boolean_Htable.Nil;
procedure Recursive_Check (Project : Project_Id); procedure Recursive_Check
(Project : Project_Id; Tree : Project_Tree_Ref);
-- Check if a project has already been seen. If not seen, mark it as -- Check if a project has already been seen. If not seen, mark it as
-- Seen, Call Action, and check all its imported projects. -- Seen, Call Action, and check all its imported projects.
@ -419,29 +421,34 @@ package body Prj is
-- Recursive_Check -- -- Recursive_Check --
--------------------- ---------------------
procedure Recursive_Check (Project : Project_Id) is procedure Recursive_Check
(Project : Project_Id; Tree : Project_Tree_Ref)
is
List : Project_List; List : Project_List;
Agg : Aggregated_Project_List; Agg : Aggregated_Project_List;
begin begin
if not Get (Seen, Project) then if not Get (Seen, Project) then
-- Even if a project is aggregated multiple times, we will only
-- return it once.
Set (Seen, Project, True); Set (Seen, Project, True);
if not Imported_First then if not Imported_First then
Action (Project, With_State); Action (Project, Tree, With_State);
end if; end if;
-- Visit all extended projects -- Visit all extended projects
if Project.Extends /= No_Project then if Project.Extends /= No_Project then
Recursive_Check (Project.Extends); Recursive_Check (Project.Extends, Tree);
end if; end if;
-- Visit all imported projects -- Visit all imported projects
List := Project.Imported_Projects; List := Project.Imported_Projects;
while List /= null loop while List /= null loop
Recursive_Check (List.Project); Recursive_Check (List.Project, Tree);
List := List.Next; List := List.Next;
end loop; end loop;
@ -453,13 +460,13 @@ package body Prj is
Agg := Project.Aggregated_Projects; Agg := Project.Aggregated_Projects;
while Agg /= null loop while Agg /= null loop
pragma Assert (Agg.Project /= No_Project); pragma Assert (Agg.Project /= No_Project);
Recursive_Check (Agg.Project); Recursive_Check (Agg.Project, Agg.Tree);
Agg := Agg.Next; Agg := Agg.Next;
end loop; end loop;
end if; end if;
if Imported_First then if Imported_First then
Action (Project, With_State); Action (Project, Tree, With_State);
end if; end if;
end if; end if;
end Recursive_Check; end Recursive_Check;
@ -467,7 +474,7 @@ package body Prj is
-- Start of processing for For_Every_Project_Imported -- Start of processing for For_Every_Project_Imported
begin begin
Recursive_Check (Project => By); Recursive_Check (Project => By, Tree => Tree);
Reset (Seen); Reset (Seen);
end For_Every_Project_Imported; end For_Every_Project_Imported;
@ -484,18 +491,25 @@ package body Prj is
is is
Result : Source_Id := No_Source; Result : Source_Id := No_Source;
procedure Look_For_Sources (Proj : Project_Id; Src : in out Source_Id); procedure Look_For_Sources
(Proj : Project_Id;
Tree : Project_Tree_Ref;
Src : in out Source_Id);
-- Look for Base_Name in the sources of Proj -- Look for Base_Name in the sources of Proj
---------------------- ----------------------
-- Look_For_Sources -- -- Look_For_Sources --
---------------------- ----------------------
procedure Look_For_Sources (Proj : Project_Id; Src : in out Source_Id) is procedure Look_For_Sources
(Proj : Project_Id;
Tree : Project_Tree_Ref;
Src : in out Source_Id)
is
Iterator : Source_Iterator; Iterator : Source_Iterator;
begin begin
Iterator := For_Each_Source (In_Tree => In_Tree, Project => Proj); Iterator := For_Each_Source (In_Tree => Tree, Project => Proj);
while Element (Iterator) /= No_Source loop while Element (Iterator) /= No_Source loop
if Element (Iterator).File = Base_Name then if Element (Iterator).File = Base_Name then
Src := Element (Iterator); Src := Element (Iterator);
@ -517,22 +531,23 @@ package body Prj is
if In_Extended_Only then if In_Extended_Only then
Proj := Project; Proj := Project;
while Proj /= No_Project loop while Proj /= No_Project loop
Look_For_Sources (Proj, Result); Look_For_Sources (Proj, In_Tree, Result);
exit when Result /= No_Source; exit when Result /= No_Source;
Proj := Proj.Extends; Proj := Proj.Extends;
end loop; end loop;
elsif In_Imported_Only then elsif In_Imported_Only then
Look_For_Sources (Project, Result); Look_For_Sources (Project, In_Tree, Result);
if Result = No_Source then if Result = No_Source then
For_Imported_Projects For_Imported_Projects
(By => Project, (By => Project,
Tree => In_Tree,
With_State => Result); With_State => Result);
end if; end if;
else else
Look_For_Sources (No_Project, Result); Look_For_Sources (No_Project, In_Tree, Result);
end if; end if;
return Result; return Result;
@ -604,12 +619,9 @@ package body Prj is
Prj.Attr.Initialize; Prj.Attr.Initialize;
Set_Name_Table_Byte Set_Name_Table_Byte (Name_Project, Token_Type'Pos (Tok_Project));
(Name_Project, Token_Type'Pos (Tok_Project)); Set_Name_Table_Byte (Name_Extends, Token_Type'Pos (Tok_Extends));
Set_Name_Table_Byte Set_Name_Table_Byte (Name_External, Token_Type'Pos (Tok_External));
(Name_Extends, Token_Type'Pos (Tok_Extends));
Set_Name_Table_Byte
(Name_External, Token_Type'Pos (Tok_External));
Set_Name_Table_Byte Set_Name_Table_Byte
(Name_External_As_List, Token_Type'Pos (Tok_External_As_List)); (Name_External_As_List, Token_Type'Pos (Tok_External_As_List));
end if; end if;
@ -716,6 +728,9 @@ package body Prj is
begin begin
while List /= null loop while List /= null loop
Tmp := List.Next; Tmp := List.Next;
Free (List.Tree);
Unchecked_Free (List); Unchecked_Free (List);
List := Tmp; List := Tmp;
end loop; end loop;
@ -731,6 +746,7 @@ package body Prj is
Project.Aggregated_Projects := new Aggregated_Project' Project.Aggregated_Projects := new Aggregated_Project'
(Path => Path, (Path => Path,
Project => No_Project, Project => No_Project,
Tree => null,
Next => Project.Aggregated_Projects); Next => Project.Aggregated_Projects);
end Add_Aggregated_Project; end Add_Aggregated_Project;
@ -888,13 +904,16 @@ package body Prj is
begin begin
if Tree /= null then if Tree /= null then
Name_List_Table.Free (Tree.Name_Lists); if Tree.Is_Root_Tree then
Number_List_Table.Free (Tree.Number_Lists); Name_List_Table.Free (Tree.Shared.Name_Lists);
String_Element_Table.Free (Tree.String_Elements); Number_List_Table.Free (Tree.Shared.Number_Lists);
Variable_Element_Table.Free (Tree.Variable_Elements); String_Element_Table.Free (Tree.Shared.String_Elements);
Array_Element_Table.Free (Tree.Array_Elements); Variable_Element_Table.Free (Tree.Shared.Variable_Elements);
Array_Table.Free (Tree.Arrays); Array_Element_Table.Free (Tree.Shared.Array_Elements);
Package_Table.Free (Tree.Packages); Array_Table.Free (Tree.Shared.Arrays);
Package_Table.Free (Tree.Shared.Packages);
end if;
Source_Paths_Htable.Reset (Tree.Source_Paths_HT); Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
Source_Files_Htable.Reset (Tree.Source_Files_HT); Source_Files_Htable.Reset (Tree.Source_Files_HT);
@ -917,13 +936,21 @@ package body Prj is
begin begin
-- Visible tables -- Visible tables
Name_List_Table.Init (Tree.Name_Lists); if Tree.Is_Root_Tree then
Number_List_Table.Init (Tree.Number_Lists); -- We cannot use 'Access here:
String_Element_Table.Init (Tree.String_Elements); -- "illegal attribute for discriminant-dependent component"
Variable_Element_Table.Init (Tree.Variable_Elements); -- However, we know this is valid since Shared and Shared_Data have
Array_Element_Table.Init (Tree.Array_Elements); -- the same lifetime and will always exist concurrently.
Array_Table.Init (Tree.Arrays); Tree.Shared := Tree.Shared_Data'Unrestricted_Access;
Package_Table.Init (Tree.Packages); Name_List_Table.Init (Tree.Shared.Name_Lists);
Number_List_Table.Init (Tree.Shared.Number_Lists);
String_Element_Table.Init (Tree.Shared.String_Elements);
Variable_Element_Table.Init (Tree.Shared.Variable_Elements);
Array_Element_Table.Init (Tree.Shared.Array_Elements);
Array_Table.Init (Tree.Shared.Arrays);
Package_Table.Init (Tree.Shared.Packages);
end if;
Source_Paths_Htable.Reset (Tree.Source_Paths_HT); Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
Source_Files_Htable.Reset (Tree.Source_Files_HT); Source_Files_Htable.Reset (Tree.Source_Files_HT);
Replaced_Source_HTable.Reset (Tree.Replaced_Sources); Replaced_Source_HTable.Reset (Tree.Replaced_Sources);
@ -1110,7 +1137,10 @@ package body Prj is
procedure Compute_All_Imported_Projects (Tree : Project_Tree_Ref) is procedure Compute_All_Imported_Projects (Tree : Project_Tree_Ref) is
Project : Project_Id; Project : Project_Id;
procedure Recursive_Add (Prj : Project_Id; Dummy : in out Boolean); procedure Recursive_Add
(Prj : Project_Id;
Tree : Project_Tree_Ref;
Dummy : in out Boolean);
-- Recursively add the projects imported by project Project, but not -- Recursively add the projects imported by project Project, but not
-- those that are extended. -- those that are extended.
@ -1118,8 +1148,12 @@ package body Prj is
-- Recursive_Add -- -- Recursive_Add --
------------------- -------------------
procedure Recursive_Add (Prj : Project_Id; Dummy : in out Boolean) is procedure Recursive_Add
pragma Unreferenced (Dummy); (Prj : Project_Id;
Tree : Project_Tree_Ref;
Dummy : in out Boolean)
is
pragma Unreferenced (Dummy, Tree);
List : Project_List; List : Project_List;
Prj2 : Project_Id; Prj2 : Project_Id;
@ -1163,7 +1197,7 @@ package body Prj is
while List /= null loop while List /= null loop
Project := List.Project; Project := List.Project;
Free_List (Project.All_Imported_Projects, Free_Project => False); Free_List (Project.All_Imported_Projects, Free_Project => False);
For_All_Projects (Project, Dummy); For_All_Projects (Project, Tree, Dummy, Include_Aggregated => False);
List := List.Next; List := List.Next;
end loop; end loop;
end Compute_All_Imported_Projects; end Compute_All_Imported_Projects;

87
gcc/ada/prj.ads
View File

@ -1094,6 +1094,7 @@ package Prj is
type Aggregated_Project_List is access all Aggregated_Project; type Aggregated_Project_List is access all Aggregated_Project;
type Aggregated_Project is record type Aggregated_Project is record
Path : Path_Name_Type; Path : Path_Name_Type;
Tree : Project_Tree_Ref;
Project : Project_Id; Project : Project_Id;
Next : Aggregated_Project_List; Next : Aggregated_Project_List;
end record; end record;
@ -1400,41 +1401,68 @@ package Prj is
type Private_Project_Tree_Data is private; type Private_Project_Tree_Data is private;
-- Data for a project tree that is used only by the Project Manager -- Data for a project tree that is used only by the Project Manager
type Project_Tree_Data is type Shared_Project_Tree_Data is record
record Name_Lists : Name_List_Table.Instance;
Name_Lists : Name_List_Table.Instance; Number_Lists : Number_List_Table.Instance;
Number_Lists : Number_List_Table.Instance; String_Elements : String_Element_Table.Instance;
String_Elements : String_Element_Table.Instance; Variable_Elements : Variable_Element_Table.Instance;
Variable_Elements : Variable_Element_Table.Instance; Array_Elements : Array_Element_Table.Instance;
Array_Elements : Array_Element_Table.Instance; Arrays : Array_Table.Instance;
Arrays : Array_Table.Instance; Packages : Package_Table.Instance;
Packages : Package_Table.Instance; end record;
Projects : Project_List; 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
-- loaded through the same aggregate project.
-- To avoid ambiguities, limit the number of parameters to the
-- subprograms (we would have to parse the "root project tree" since this
-- is where the configuration file was loaded, in addition to the project's
-- own tree) and make the comparison of projects easier, all trees store
-- the lists in the same tables.
Replaced_Sources : Replaced_Source_HTable.Instance; type Project_Tree_Data (Is_Root_Tree : Boolean := True) is record
-- The list of sources that have been replaced by sources with -- The root tree is the one loaded by the user from the command line.
-- different file names. -- Is_Root_Tree is only false for projects aggregated within a root
-- aggregate project.
Replaced_Source_Number : Natural := 0; Projects : Project_List;
-- The number of entries in Replaced_Sources -- List of projects in this tree
Units_HT : Units_Htable.Instance; Replaced_Sources : Replaced_Source_HTable.Instance;
-- Unit name to Unit_Index (and from there to Source_Id) -- The list of sources that have been replaced by sources with
-- different file names.
Source_Files_HT : Source_Files_Htable.Instance; Replaced_Source_Number : Natural := 0;
-- Base source file names to Source_Id list. -- The number of entries in Replaced_Sources
Source_Paths_HT : Source_Paths_Htable.Instance; Units_HT : Units_Htable.Instance;
-- Full path to Source_Id -- Unit name to Unit_Index (and from there to Source_Id)
Source_Info_File_Name : String_Access := null; Source_Files_HT : Source_Files_Htable.Instance;
-- The name of the source info file, if specified by the builder -- Base source file names to Source_Id list.
Source_Info_File_Exists : Boolean := False; Source_Paths_HT : Source_Paths_Htable.Instance;
-- True when a source info file has been successfully read -- Full path to Source_Id
Private_Part : Private_Project_Tree_Data; Source_Info_File_Name : String_Access := null;
end record; -- The name of the source info file, if specified by the builder
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.
case Is_Root_Tree is
when True =>
Shared_Data : aliased Shared_Project_Tree_Data;
-- Do not access directly, only through Shared.
when False =>
null;
end case;
end record;
-- Data for a project tree -- Data for a project tree
procedure Expect (The_Token : Token_Type; Token_Image : String); procedure Expect (The_Token : Token_Type; Token_Image : String);
@ -1463,9 +1491,11 @@ package Prj is
type State is limited private; type State is limited private;
with procedure Action with procedure Action
(Project : Project_Id; (Project : Project_Id;
Tree : Project_Tree_Ref;
With_State : in out State); With_State : in out State);
procedure For_Every_Project_Imported procedure For_Every_Project_Imported
(By : Project_Id; (By : Project_Id;
Tree : Project_Tree_Ref;
With_State : in out State; With_State : in out State;
Include_Aggregated : Boolean := True; Include_Aggregated : Boolean := True;
Imported_First : Boolean := False); Imported_First : Boolean := False);
@ -1488,6 +1518,9 @@ package Prj is
-- If Include_Aggregated is True, then an aggregate project will recurse -- If Include_Aggregated is True, then an aggregate project will recurse
-- into the projects it aggregates. Otherwise, the latter are never -- into the projects it aggregates. Otherwise, the latter are never
-- returned -- returned
--
-- The Tree argument passed to the callback is required in the case of
-- aggregated projects, since they might not be using the same tree as 'By'
function Extend_Name function Extend_Name
(File : File_Name_Type; (File : File_Name_Type;