Skip to content

R
riscv-gcc-1
Commit 40ecf2f5 by Emmanuel Briot Committed by Arnaud Charlet
Options

gnatcmd.adb, [...] (Shared_Project_Tree_Data): new type An aggregate project and… 

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
parent 9fde638d
Showing with 1009 additions and 807 deletions
gcc/ada/ChangeLog
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,
......
gcc/ada/clean.adb
...@@ -1170,7 +1170,7 @@ package body Clean is ...@@ -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 ...@@ -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 ...@@ -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);
......
gcc/ada/gnatcmd.adb
...@@ -255,6 +255,7 @@ procedure GNATCmd is ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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
......
gcc/ada/make.adb
...@@ -1288,7 +1288,8 @@ package body Make is ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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,
......
gcc/ada/makeutl.adb
...@@ -695,7 +695,7 @@ package body Makeutl is ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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;
......
gcc/ada/makeutl.ads
...@@ -40,7 +40,8 @@ package Makeutl is ...@@ -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=";
......
gcc/ada/mlib-prj.adb
...@@ -6,7 +6,7 @@ ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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;
......
gcc/ada/prj-conf.adb
...@@ -101,6 +101,17 @@ package body Prj.Conf is ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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
......
gcc/ada/prj-conf.ads
...@@ -162,17 +162,6 @@ package Prj.Conf is ...@@ -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);
......
gcc/ada/prj-env.adb
...@@ -76,7 +76,7 @@ package body Prj.Env is ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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
......
gcc/ada/prj-env.ads
...@@ -88,6 +88,7 @@ package Prj.Env is ...@@ -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 ...@@ -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.
......
gcc/ada/prj-nmsc.adb
...@@ -507,7 +507,8 @@ package body Prj.Nmsc is ...@@ -507,7 +507,8 @@ package body Prj.Nmsc is
-- when there are no sources for language Lang_Name. -- when there are no sources for language Lang_Name.
procedure Show_Source_Dirs procedure Show_Source_Dirs
(Project : Project_Id; In_Tree : Project_Tree_Ref); (Project : Project_Id;
Shared : Shared_Project_Tree_Data_Access);
-- List all the source directories of a project -- List all the source directories of a project
procedure Write_Attr (Name, Value : String); procedure Write_Attr (Name, Value : String);
...@@ -651,7 +652,6 @@ package body Prj.Nmsc is ...@@ -651,7 +652,6 @@ package body Prj.Nmsc is
Add_Src : Boolean; Add_Src : Boolean;
Source : Source_Id; Source : Source_Id;
Prev_Unit : Unit_Index := No_Unit_Index; Prev_Unit : Unit_Index := No_Unit_Index;
Source_To_Replace : Source_Id := No_Source; Source_To_Replace : Source_Id := No_Source;
begin begin
...@@ -939,7 +939,7 @@ package body Prj.Nmsc is ...@@ -939,7 +939,7 @@ package body Prj.Nmsc is
Prj.Util.Value_Of Prj.Util.Value_Of
(Snames.Name_Project_Files, (Snames.Name_Project_Files,
Project.Decl.Attributes, Project.Decl.Attributes,
Tree); Tree.Shared);
Project_Path_For_Aggregate : Prj.Env.Project_Search_Path; Project_Path_For_Aggregate : Prj.Env.Project_Search_Path;
...@@ -958,22 +958,27 @@ package body Prj.Nmsc is ...@@ -958,22 +958,27 @@ package body Prj.Nmsc is
procedure Found_Project_File (Path : Path_Information; Rank : Natural) is procedure Found_Project_File (Path : Path_Information; Rank : Natural) is
pragma Unreferenced (Rank); pragma Unreferenced (Rank);
begin begin
Debug_Output ("Aggregates: ", Name_Id (Path.Display_Name)); if Path.Name /= Project.Path.Name then
Debug_Output ("Aggregates: ", Name_Id (Path.Display_Name));
-- For usual "with" statement, this phase will have been done when
-- parsing the project itself. However, for aggregate projects, we -- For usual "with" statement, this phase will have been done when
-- can only do this when processing the aggregate project, since the -- parsing the project itself. However, for aggregate projects, we
-- exact list of project files or project directories can depend on -- can only do this when processing the aggregate project, since
-- scenario variables. -- the exact list of project files or project directories can
-- -- depend on scenario variables.
-- We only load the projects explicitly here, but do not process --
-- them. For the processing, Prj.Proc will take care of processing -- We only load the projects explicitly here, but do not process
-- them, within the same call to Recursive_Process (thus avoiding the -- them. For the processing, Prj.Proc will take care of processing
-- processing of a given project multiple times). -- them, within the same call to Recursive_Process (thus avoiding
-- -- the processing of a given project multiple times).
-- ??? We might already have loaded the project --
-- ??? We might already have loaded the project
Add_Aggregated_Project (Project, Path => Path.Name);
Add_Aggregated_Project (Project, Path => Path.Name);
else
Debug_Output ("Pattern returned the aggregate itself, ignored");
end if;
end Found_Project_File; end Found_Project_File;
-- Start of processing for Check_Aggregate_Project -- Start of processing for Check_Aggregate_Project
...@@ -1021,22 +1026,24 @@ package body Prj.Nmsc is ...@@ -1021,22 +1026,24 @@ package body Prj.Nmsc is
(Project : Project_Id; (Project : Project_Id;
Data : in out Tree_Processing_Data) Data : in out Tree_Processing_Data)
is is
Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
Source_Dirs : constant Variable_Value := Source_Dirs : constant Variable_Value :=
Util.Value_Of Util.Value_Of
(Name_Source_Dirs, (Name_Source_Dirs,
Project.Decl.Attributes, Data.Tree); Project.Decl.Attributes, Shared);
Source_Files : constant Variable_Value := Source_Files : constant Variable_Value :=
Util.Value_Of Util.Value_Of
(Name_Source_Files, (Name_Source_Files,
Project.Decl.Attributes, Data.Tree); Project.Decl.Attributes, Shared);
Source_List_File : constant Variable_Value := Source_List_File : constant Variable_Value :=
Util.Value_Of Util.Value_Of
(Name_Source_List_File, (Name_Source_List_File,
Project.Decl.Attributes, Data.Tree); Project.Decl.Attributes, Shared);
Languages : constant Variable_Value := Languages : constant Variable_Value :=
Util.Value_Of Util.Value_Of
(Name_Languages, (Name_Languages,
Project.Decl.Attributes, Data.Tree); Project.Decl.Attributes, Shared);
begin begin
if Project.Source_Dirs /= Nil_String then if Project.Source_Dirs /= Nil_String then
...@@ -1065,6 +1072,7 @@ package body Prj.Nmsc is ...@@ -1065,6 +1072,7 @@ package body Prj.Nmsc is
(Project : Project_Id; (Project : Project_Id;
Data : in out Tree_Processing_Data) Data : in out Tree_Processing_Data)
is is
Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
Prj_Data : Project_Processing_Data; Prj_Data : Project_Processing_Data;
begin begin
...@@ -1079,7 +1087,7 @@ package body Prj.Nmsc is ...@@ -1079,7 +1087,7 @@ package body Prj.Nmsc is
Check_Programming_Languages (Project, Data); Check_Programming_Languages (Project, Data);
if Current_Verbosity = High then if Current_Verbosity = High then
Show_Source_Dirs (Project, Data.Tree); Show_Source_Dirs (Project, Shared);
end if; end if;
end if; end if;
...@@ -1303,6 +1311,9 @@ package body Prj.Nmsc is ...@@ -1303,6 +1311,9 @@ package body Prj.Nmsc is
(Project : Project_Id; (Project : Project_Id;
Data : in out Tree_Processing_Data) Data : in out Tree_Processing_Data)
is is
Shared : constant Shared_Project_Tree_Data_Access :=
Data.Tree.Shared;
Dot_Replacement : File_Name_Type := No_File; Dot_Replacement : File_Name_Type := No_File;
Casing : Casing_Type := All_Lower_Case; Casing : Casing_Type := All_Lower_Case;
Separate_Suffix : File_Name_Type := No_File; Separate_Suffix : File_Name_Type := No_File;
...@@ -1364,11 +1375,11 @@ package body Prj.Nmsc is ...@@ -1364,11 +1375,11 @@ package body Prj.Nmsc is
Current_Array_Id := Arrays; Current_Array_Id := Arrays;
while Current_Array_Id /= No_Array loop while Current_Array_Id /= No_Array loop
Current_Array := Data.Tree.Arrays.Table (Current_Array_Id); Current_Array := Shared.Arrays.Table (Current_Array_Id);
Element_Id := Current_Array.Value; Element_Id := Current_Array.Value;
while Element_Id /= No_Array_Element loop while Element_Id /= No_Array_Element loop
Element := Data.Tree.Array_Elements.Table (Element_Id); Element := Shared.Array_Elements.Table (Element_Id);
if Element.Index /= All_Other_Names then if Element.Index /= All_Other_Names then
...@@ -1441,8 +1452,7 @@ package body Prj.Nmsc is ...@@ -1441,8 +1452,7 @@ package body Prj.Nmsc is
Attribute_Id := Attributes; Attribute_Id := Attributes;
while Attribute_Id /= No_Variable loop while Attribute_Id /= No_Variable loop
Attribute := Attribute := Shared.Variable_Elements.Table (Attribute_Id);
Data.Tree.Variable_Elements.Table (Attribute_Id);
if not Attribute.Value.Default then if not Attribute.Value.Default then
if Attribute.Name = Name_Executable_Suffix then if Attribute.Name = Name_Executable_Suffix then
...@@ -1475,11 +1485,11 @@ package body Prj.Nmsc is ...@@ -1475,11 +1485,11 @@ package body Prj.Nmsc is
Current_Array_Id := Arrays; Current_Array_Id := Arrays;
while Current_Array_Id /= No_Array loop while Current_Array_Id /= No_Array loop
Current_Array := Data.Tree.Arrays.Table (Current_Array_Id); Current_Array := Shared.Arrays.Table (Current_Array_Id);
Element_Id := Current_Array.Value; Element_Id := Current_Array.Value;
while Element_Id /= No_Array_Element loop while Element_Id /= No_Array_Element loop
Element := Data.Tree.Array_Elements.Table (Element_Id); Element := Shared.Array_Elements.Table (Element_Id);
if Element.Index /= All_Other_Names then if Element.Index /= All_Other_Names then
...@@ -1806,7 +1816,7 @@ package body Prj.Nmsc is ...@@ -1806,7 +1816,7 @@ package body Prj.Nmsc is
Attribute_Id := Attributes; Attribute_Id := Attributes;
while Attribute_Id /= No_Variable loop while Attribute_Id /= No_Variable loop
Attribute := Data.Tree.Variable_Elements.Table (Attribute_Id); Attribute := Shared.Variable_Elements.Table (Attribute_Id);
if not Attribute.Value.Default then if not Attribute.Value.Default then
if Attribute.Name = Name_Separate_Suffix then if Attribute.Name = Name_Separate_Suffix then
...@@ -1857,11 +1867,11 @@ package body Prj.Nmsc is ...@@ -1857,11 +1867,11 @@ package body Prj.Nmsc is
Current_Array_Id := Arrays; Current_Array_Id := Arrays;
while Current_Array_Id /= No_Array loop while Current_Array_Id /= No_Array loop
Current_Array := Data.Tree.Arrays.Table (Current_Array_Id); Current_Array := Shared.Arrays.Table (Current_Array_Id);
Element_Id := Current_Array.Value; Element_Id := Current_Array.Value;
while Element_Id /= No_Array_Element loop while Element_Id /= No_Array_Element loop
Element := Data.Tree.Array_Elements.Table (Element_Id); Element := Shared.Array_Elements.Table (Element_Id);
-- Get the name of the language -- Get the name of the language
...@@ -1918,8 +1928,7 @@ package body Prj.Nmsc is ...@@ -1918,8 +1928,7 @@ package body Prj.Nmsc is
Attribute_Id := Attributes; Attribute_Id := Attributes;
while Attribute_Id /= No_Variable loop while Attribute_Id /= No_Variable loop
Attribute := Attribute := Shared.Variable_Elements.Table (Attribute_Id);
Data.Tree.Variable_Elements.Table (Attribute_Id);
if not Attribute.Value.Default then if not Attribute.Value.Default then
if Attribute.Name = Name_Driver then if Attribute.Name = Name_Driver then
...@@ -2026,7 +2035,7 @@ package body Prj.Nmsc is ...@@ -2026,7 +2035,7 @@ package body Prj.Nmsc is
begin begin
Packages := Project.Decl.Packages; Packages := Project.Decl.Packages;
while Packages /= No_Package loop while Packages /= No_Package loop
Element := Data.Tree.Packages.Table (Packages); Element := Shared.Packages.Table (Packages);
case Element.Name is case Element.Name is
when Name_Binder => when Name_Binder =>
...@@ -2082,8 +2091,7 @@ package body Prj.Nmsc is ...@@ -2082,8 +2091,7 @@ package body Prj.Nmsc is
Attribute_Id := Project.Decl.Attributes; Attribute_Id := Project.Decl.Attributes;
while Attribute_Id /= No_Variable loop while Attribute_Id /= No_Variable loop
Attribute := Attribute := Shared.Variable_Elements.Table (Attribute_Id);
Data.Tree.Variable_Elements.Table (Attribute_Id);
if not Attribute.Value.Default then if not Attribute.Value.Default then
if Attribute.Name = Name_Target then if Attribute.Name = Name_Target then
...@@ -2400,11 +2408,11 @@ package body Prj.Nmsc is ...@@ -2400,11 +2408,11 @@ package body Prj.Nmsc is
Current_Array_Id := Project.Decl.Arrays; Current_Array_Id := Project.Decl.Arrays;
while Current_Array_Id /= No_Array loop while Current_Array_Id /= No_Array loop
Current_Array := Data.Tree.Arrays.Table (Current_Array_Id); Current_Array := Shared.Arrays.Table (Current_Array_Id);
Element_Id := Current_Array.Value; Element_Id := Current_Array.Value;
while Element_Id /= No_Array_Element loop while Element_Id /= No_Array_Element loop
Element := Data.Tree.Array_Elements.Table (Element_Id); Element := Shared.Array_Elements.Table (Element_Id);
-- Get the name of the language -- Get the name of the language
...@@ -2684,10 +2692,11 @@ package body Prj.Nmsc is ...@@ -2684,10 +2692,11 @@ package body Prj.Nmsc is
(Project : Project_Id; (Project : Project_Id;
Data : in out Tree_Processing_Data) Data : in out Tree_Processing_Data)
is is
Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
Externally_Built : constant Variable_Value := Externally_Built : constant Variable_Value :=
Util.Value_Of Util.Value_Of
(Name_Externally_Built, (Name_Externally_Built,
Project.Decl.Attributes, Data.Tree); Project.Decl.Attributes, Shared);
begin begin
if not Externally_Built.Default then if not Externally_Built.Default then
...@@ -2726,17 +2735,19 @@ package body Prj.Nmsc is ...@@ -2726,17 +2735,19 @@ package body Prj.Nmsc is
(Project : Project_Id; (Project : Project_Id;
Data : in out Tree_Processing_Data) Data : in out Tree_Processing_Data)
is is
Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
Interfaces : constant Prj.Variable_Value := Interfaces : constant Prj.Variable_Value :=
Prj.Util.Value_Of Prj.Util.Value_Of
(Snames.Name_Interfaces, (Snames.Name_Interfaces,
Project.Decl.Attributes, Project.Decl.Attributes,
Data.Tree); Shared);
Library_Interface : constant Prj.Variable_Value := Library_Interface : constant Prj.Variable_Value :=
Prj.Util.Value_Of Prj.Util.Value_Of
(Snames.Name_Library_Interface, (Snames.Name_Library_Interface,
Project.Decl.Attributes, Project.Decl.Attributes,
Data.Tree); Shared);
List : String_List_Id; List : String_List_Id;
Element : String_Element; Element : String_Element;
...@@ -2767,7 +2778,7 @@ package body Prj.Nmsc is ...@@ -2767,7 +2778,7 @@ package body Prj.Nmsc is
List := Interfaces.Values; List := Interfaces.Values;
while List /= Nil_String loop while List /= Nil_String loop
Element := Data.Tree.String_Elements.Table (List); Element := Shared.String_Elements.Table (List);
Name := Canonical_Case_File_Name (Element.Value); Name := Canonical_Case_File_Name (Element.Value);
Project_2 := Project; Project_2 := Project;
...@@ -2840,7 +2851,7 @@ package body Prj.Nmsc is ...@@ -2840,7 +2851,7 @@ package body Prj.Nmsc is
List := Library_Interface.Values; List := Library_Interface.Values;
while List /= Nil_String loop while List /= Nil_String loop
Element := Data.Tree.String_Elements.Table (List); Element := Shared.String_Elements.Table (List);
Get_Name_String (Element.Value); Get_Name_String (Element.Value);
To_Lower (Name_Buffer (1 .. Name_Len)); To_Lower (Name_Buffer (1 .. Name_Len));
Name := Name_Find; Name := Name_Find;
...@@ -2913,9 +2924,10 @@ package body Prj.Nmsc is ...@@ -2913,9 +2924,10 @@ package body Prj.Nmsc is
(Project : Project_Id; (Project : Project_Id;
Data : in out Tree_Processing_Data) Data : in out Tree_Processing_Data)
is is
Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
Naming_Id : constant Package_Id := Naming_Id : constant Package_Id :=
Util.Value_Of Util.Value_Of
(Name_Naming, Project.Decl.Packages, Data.Tree); (Name_Naming, Project.Decl.Packages, Shared);
Naming : Package_Element; Naming : Package_Element;
Ada_Body_Suffix_Loc : Source_Ptr := No_Location; Ada_Body_Suffix_Loc : Source_Ptr := No_Location;
...@@ -2957,17 +2969,17 @@ package body Prj.Nmsc is ...@@ -2957,17 +2969,17 @@ package body Prj.Nmsc is
Util.Value_Of Util.Value_Of
(Name_Dot_Replacement, (Name_Dot_Replacement,
Naming.Decl.Attributes, Naming.Decl.Attributes,
Data.Tree); Shared);
Casing_String : constant Variable_Value := Casing_String : constant Variable_Value :=
Util.Value_Of Util.Value_Of
(Name_Casing, (Name_Casing,
Naming.Decl.Attributes, Naming.Decl.Attributes,
Data.Tree); Shared);
Sep_Suffix : constant Variable_Value := Sep_Suffix : constant Variable_Value :=
Util.Value_Of Util.Value_Of
(Name_Separate_Suffix, (Name_Separate_Suffix,
Naming.Decl.Attributes, Naming.Decl.Attributes,
Data.Tree); Shared);
Dot_Repl_Loc : Source_Ptr; Dot_Repl_Loc : Source_Ptr;
begin begin
...@@ -3105,26 +3117,26 @@ package body Prj.Nmsc is ...@@ -3105,26 +3117,26 @@ package body Prj.Nmsc is
Value_Of Value_Of
(Name_Implementation_Exceptions, (Name_Implementation_Exceptions,
In_Arrays => Naming.Decl.Arrays, In_Arrays => Naming.Decl.Arrays,
In_Tree => Data.Tree); Shared => Shared);
when Spec => when Spec =>
Exceptions := Exceptions :=
Value_Of Value_Of
(Name_Specification_Exceptions, (Name_Specification_Exceptions,
In_Arrays => Naming.Decl.Arrays, In_Arrays => Naming.Decl.Arrays,
In_Tree => Data.Tree); Shared => Shared);
end case; end case;
Exception_List := Exception_List :=
Value_Of Value_Of
(Index => Lang, (Index => Lang,
In_Array => Exceptions, In_Array => Exceptions,
In_Tree => Data.Tree); Shared => Shared);
if Exception_List /= Nil_Variable_Value then if Exception_List /= Nil_Variable_Value then
Element_Id := Exception_List.Values; Element_Id := Exception_List.Values;
while Element_Id /= Nil_String loop while Element_Id /= Nil_String loop
Element := Data.Tree.String_Elements.Table (Element_Id); Element := Shared.String_Elements.Table (Element_Id);
File_Name := Canonical_Case_File_Name (Element.Value); File_Name := Canonical_Case_File_Name (Element.Value);
Source := Source :=
...@@ -3200,14 +3212,14 @@ package body Prj.Nmsc is ...@@ -3200,14 +3212,14 @@ package body Prj.Nmsc is
Value_Of Value_Of
(Name_Body, (Name_Body,
In_Arrays => Naming.Decl.Arrays, In_Arrays => Naming.Decl.Arrays,
In_Tree => Data.Tree); Shared => Shared);
if Exceptions = No_Array_Element then if Exceptions = No_Array_Element then
Exceptions := Exceptions :=
Value_Of Value_Of
(Name_Implementation, (Name_Implementation,
In_Arrays => Naming.Decl.Arrays, In_Arrays => Naming.Decl.Arrays,
In_Tree => Data.Tree); Shared => Shared);
end if; end if;
when Spec => when Spec =>
...@@ -3215,19 +3227,19 @@ package body Prj.Nmsc is ...@@ -3215,19 +3227,19 @@ package body Prj.Nmsc is
Value_Of Value_Of
(Name_Spec, (Name_Spec,
In_Arrays => Naming.Decl.Arrays, In_Arrays => Naming.Decl.Arrays,
In_Tree => Data.Tree); Shared => Shared);
if Exceptions = No_Array_Element then if Exceptions = No_Array_Element then
Exceptions := Exceptions :=
Value_Of Value_Of
(Name_Spec, (Name_Spec,
In_Arrays => Naming.Decl.Arrays, In_Arrays => Naming.Decl.Arrays,
In_Tree => Data.Tree); Shared => Shared);
end if; end if;
end case; end case;
while Exceptions /= No_Array_Element loop while Exceptions /= No_Array_Element loop
Element := Data.Tree.Array_Elements.Table (Exceptions); Element := Shared.Array_Elements.Table (Exceptions);
File_Name := Canonical_Case_File_Name (Element.Value.Value); File_Name := Canonical_Case_File_Name (Element.Value.Value);
Get_Name_String (Element.Index); Get_Name_String (Element.Index);
...@@ -3332,14 +3344,14 @@ package body Prj.Nmsc is ...@@ -3332,14 +3344,14 @@ package body Prj.Nmsc is
(Name => Lang, (Name => Lang,
Attribute_Or_Array_Name => Name_Spec_Suffix, Attribute_Or_Array_Name => Name_Spec_Suffix,
In_Package => Naming_Id, In_Package => Naming_Id,
In_Tree => Data.Tree); Shared => Shared);
if Suffix = Nil_Variable_Value then if Suffix = Nil_Variable_Value then
Suffix := Value_Of Suffix := Value_Of
(Name => Lang, (Name => Lang,
Attribute_Or_Array_Name => Name_Specification_Suffix, Attribute_Or_Array_Name => Name_Specification_Suffix,
In_Package => Naming_Id, In_Package => Naming_Id,
In_Tree => Data.Tree); Shared => Shared);
end if; end if;
if Suffix /= Nil_Variable_Value then if Suffix /= Nil_Variable_Value then
...@@ -3364,7 +3376,7 @@ package body Prj.Nmsc is ...@@ -3364,7 +3376,7 @@ package body Prj.Nmsc is
(Name => Lang, (Name => Lang,
Attribute_Or_Array_Name => Name_Body_Suffix, Attribute_Or_Array_Name => Name_Body_Suffix,
In_Package => Naming_Id, In_Package => Naming_Id,
In_Tree => Data.Tree); Shared => Shared);
if Suffix = Nil_Variable_Value then if Suffix = Nil_Variable_Value then
Suffix := Suffix :=
...@@ -3372,7 +3384,7 @@ package body Prj.Nmsc is ...@@ -3372,7 +3384,7 @@ package body Prj.Nmsc is
(Name => Lang, (Name => Lang,
Attribute_Or_Array_Name => Name_Implementation_Suffix, Attribute_Or_Array_Name => Name_Implementation_Suffix,
In_Package => Naming_Id, In_Package => Naming_Id,
In_Tree => Data.Tree); Shared => Shared);
end if; end if;
if Suffix /= Nil_Variable_Value then if Suffix /= Nil_Variable_Value then
...@@ -3470,13 +3482,13 @@ package body Prj.Nmsc is ...@@ -3470,13 +3482,13 @@ package body Prj.Nmsc is
Util.Value_Of Util.Value_Of
(Name_Spec_Suffix, (Name_Spec_Suffix,
Naming.Decl.Arrays, Naming.Decl.Arrays,
Data.Tree); Shared);
Impls : Array_Element_Id := Impls : Array_Element_Id :=
Util.Value_Of Util.Value_Of
(Name_Body_Suffix, (Name_Body_Suffix,
Naming.Decl.Arrays, Naming.Decl.Arrays,
Data.Tree); Shared);
Lang : Language_Ptr; Lang : Language_Ptr;
Lang_Name : Name_Id; Lang_Name : Name_Id;
...@@ -3489,7 +3501,7 @@ package body Prj.Nmsc is ...@@ -3489,7 +3501,7 @@ package body Prj.Nmsc is
-- user project, and they override the default. -- user project, and they override the default.
while Specs /= No_Array_Element loop while Specs /= No_Array_Element loop
Lang_Name := Data.Tree.Array_Elements.Table (Specs).Index; Lang_Name := Shared.Array_Elements.Table (Specs).Index;
Lang := Lang :=
Get_Language_From_Name Get_Language_From_Name
(Project, Name => Get_Name_String (Lang_Name)); (Project, Name => Get_Name_String (Lang_Name));
...@@ -3523,7 +3535,7 @@ package body Prj.Nmsc is ...@@ -3523,7 +3535,7 @@ package body Prj.Nmsc is
Lang_Name); Lang_Name);
else else
Value := Data.Tree.Array_Elements.Table (Specs).Value; Value := Shared.Array_Elements.Table (Specs).Value;
if Value.Kind = Single then if Value.Kind = Single then
Lang.Config.Naming_Data.Spec_Suffix := Lang.Config.Naming_Data.Spec_Suffix :=
...@@ -3531,11 +3543,11 @@ package body Prj.Nmsc is ...@@ -3531,11 +3543,11 @@ package body Prj.Nmsc is
end if; end if;
end if; end if;
Specs := Data.Tree.Array_Elements.Table (Specs).Next; Specs := Shared.Array_Elements.Table (Specs).Next;
end loop; end loop;
while Impls /= No_Array_Element loop while Impls /= No_Array_Element loop
Lang_Name := Data.Tree.Array_Elements.Table (Impls).Index; Lang_Name := Shared.Array_Elements.Table (Impls).Index;
Lang := Lang :=
Get_Language_From_Name Get_Language_From_Name
(Project, Name => Get_Name_String (Lang_Name)); (Project, Name => Get_Name_String (Lang_Name));
...@@ -3545,7 +3557,7 @@ package body Prj.Nmsc is ...@@ -3545,7 +3557,7 @@ package body Prj.Nmsc is
("Ignoring impl naming data (lang. not in project): ", ("Ignoring impl naming data (lang. not in project): ",
Lang_Name); Lang_Name);
else else
Value := Data.Tree.Array_Elements.Table (Impls).Value; Value := Shared.Array_Elements.Table (Impls).Value;
if Lang.Name = Name_Ada then if Lang.Name = Name_Ada then
Ada_Body_Suffix_Loc := Value.Location; Ada_Body_Suffix_Loc := Value.Location;
...@@ -3557,7 +3569,7 @@ package body Prj.Nmsc is ...@@ -3557,7 +3569,7 @@ package body Prj.Nmsc is
end if; end if;
end if; end if;
Impls := Data.Tree.Array_Elements.Table (Impls).Next; Impls := Shared.Array_Elements.Table (Impls).Next;
end loop; end loop;
end Initialize_Naming_Data; end Initialize_Naming_Data;
...@@ -3569,7 +3581,7 @@ package body Prj.Nmsc is ...@@ -3569,7 +3581,7 @@ package body Prj.Nmsc is
if Naming_Id /= No_Package if Naming_Id /= No_Package
and then Project.Qualifier /= Configuration and then Project.Qualifier /= Configuration
then then
Naming := Data.Tree.Packages.Table (Naming_Id); Naming := Shared.Packages.Table (Naming_Id);
Debug_Increase_Indent ("Checking package Naming for ", Project.Name); Debug_Increase_Indent ("Checking package Naming for ", Project.Name);
Initialize_Naming_Data; Initialize_Naming_Data;
Check_Naming; Check_Naming;
...@@ -3585,31 +3597,33 @@ package body Prj.Nmsc is ...@@ -3585,31 +3597,33 @@ package body Prj.Nmsc is
(Project : Project_Id; (Project : Project_Id;
Data : in out Tree_Processing_Data) Data : in out Tree_Processing_Data)
is is
Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
Attributes : constant Prj.Variable_Id := Project.Decl.Attributes; Attributes : constant Prj.Variable_Id := Project.Decl.Attributes;
Lib_Dir : constant Prj.Variable_Value := Lib_Dir : constant Prj.Variable_Value :=
Prj.Util.Value_Of Prj.Util.Value_Of
(Snames.Name_Library_Dir, Attributes, Data.Tree); (Snames.Name_Library_Dir, Attributes, Shared);
Lib_Name : constant Prj.Variable_Value := Lib_Name : constant Prj.Variable_Value :=
Prj.Util.Value_Of Prj.Util.Value_Of
(Snames.Name_Library_Name, Attributes, Data.Tree); (Snames.Name_Library_Name, Attributes, Shared);
Lib_Version : constant Prj.Variable_Value := Lib_Version : constant Prj.Variable_Value :=
Prj.Util.Value_Of Prj.Util.Value_Of
(Snames.Name_Library_Version, Attributes, Data.Tree); (Snames.Name_Library_Version, Attributes, Shared);
Lib_ALI_Dir : constant Prj.Variable_Value := Lib_ALI_Dir : constant Prj.Variable_Value :=
Prj.Util.Value_Of Prj.Util.Value_Of
(Snames.Name_Library_Ali_Dir, Attributes, Data.Tree); (Snames.Name_Library_Ali_Dir, Attributes, Shared);
Lib_GCC : constant Prj.Variable_Value := Lib_GCC : constant Prj.Variable_Value :=
Prj.Util.Value_Of Prj.Util.Value_Of
(Snames.Name_Library_GCC, Attributes, Data.Tree); (Snames.Name_Library_GCC, Attributes, Shared);
The_Lib_Kind : constant Prj.Variable_Value := The_Lib_Kind : constant Prj.Variable_Value :=
Prj.Util.Value_Of Prj.Util.Value_Of
(Snames.Name_Library_Kind, Attributes, Data.Tree); (Snames.Name_Library_Kind, Attributes, Shared);
Imported_Project_List : Project_List; Imported_Project_List : Project_List;
...@@ -3839,7 +3853,7 @@ package body Prj.Nmsc is ...@@ -3839,7 +3853,7 @@ package body Prj.Nmsc is
Dirs_Id := Project.Source_Dirs; Dirs_Id := Project.Source_Dirs;
while Dirs_Id /= Nil_String loop while Dirs_Id /= Nil_String loop
Dir_Elem := Data.Tree.String_Elements.Table (Dirs_Id); Dir_Elem := Shared.String_Elements.Table (Dirs_Id);
Dirs_Id := Dir_Elem.Next; Dirs_Id := Dir_Elem.Next;
if Project.Library_Dir.Name = if Project.Library_Dir.Name =
...@@ -3871,7 +3885,7 @@ package body Prj.Nmsc is ...@@ -3871,7 +3885,7 @@ package body Prj.Nmsc is
Dir_Loop : while Dirs_Id /= Nil_String loop Dir_Loop : while Dirs_Id /= Nil_String loop
Dir_Elem := Dir_Elem :=
Data.Tree.String_Elements.Table (Dirs_Id); Shared.String_Elements.Table (Dirs_Id);
Dirs_Id := Dir_Elem.Next; Dirs_Id := Dir_Elem.Next;
if Project.Library_Dir.Name = if Project.Library_Dir.Name =
...@@ -4027,8 +4041,7 @@ package body Prj.Nmsc is ...@@ -4027,8 +4041,7 @@ package body Prj.Nmsc is
Dirs_Id := Project.Source_Dirs; Dirs_Id := Project.Source_Dirs;
while Dirs_Id /= Nil_String loop while Dirs_Id /= Nil_String loop
Dir_Elem := Dir_Elem := Shared.String_Elements.Table (Dirs_Id);
Data.Tree.String_Elements.Table (Dirs_Id);
Dirs_Id := Dir_Elem.Next; Dirs_Id := Dir_Elem.Next;
if Project.Library_ALI_Dir.Name = if Project.Library_ALI_Dir.Name =
...@@ -4061,8 +4074,7 @@ package body Prj.Nmsc is ...@@ -4061,8 +4074,7 @@ package body Prj.Nmsc is
ALI_Dir_Loop : ALI_Dir_Loop :
while Dirs_Id /= Nil_String loop while Dirs_Id /= Nil_String loop
Dir_Elem := Dir_Elem :=
Data.Tree.String_Elements.Table Shared.String_Elements.Table (Dirs_Id);
(Dirs_Id);
Dirs_Id := Dir_Elem.Next; Dirs_Id := Dir_Elem.Next;
if Project.Library_ALI_Dir.Name = if Project.Library_ALI_Dir.Name =
...@@ -4178,14 +4190,14 @@ package body Prj.Nmsc is ...@@ -4178,14 +4190,14 @@ package body Prj.Nmsc is
Value_Of Value_Of
(Name_Linker, (Name_Linker,
Project.Decl.Packages, Project.Decl.Packages,
Data.Tree); Shared);
Driver : constant Variable_Value := Driver : constant Variable_Value :=
Value_Of Value_Of
(Name => No_Name, (Name => No_Name,
Attribute_Or_Array_Name => Attribute_Or_Array_Name =>
Name_Driver, Name_Driver,
In_Package => Linker, In_Package => Linker,
In_Tree => Data.Tree); Shared => Shared);
begin begin
if Driver /= Nil_Variable_Value if Driver /= Nil_Variable_Value
...@@ -4227,26 +4239,26 @@ package body Prj.Nmsc is ...@@ -4227,26 +4239,26 @@ package body Prj.Nmsc is
Linker_Package_Id : constant Package_Id := Linker_Package_Id : constant Package_Id :=
Util.Value_Of Util.Value_Of
(Name_Linker, (Name_Linker,
Project.Decl.Packages, Data.Tree); Project.Decl.Packages, Shared);
Linker_Package : Package_Element; Linker_Package : Package_Element;
Switches : Array_Element_Id := No_Array_Element; Switches : Array_Element_Id := No_Array_Element;
begin begin
if Linker_Package_Id /= No_Package then if Linker_Package_Id /= No_Package then
Linker_Package := Data.Tree.Packages.Table (Linker_Package_Id); Linker_Package := Shared.Packages.Table (Linker_Package_Id);
Switches := Switches :=
Value_Of Value_Of
(Name => Name_Switches, (Name => Name_Switches,
In_Arrays => Linker_Package.Decl.Arrays, In_Arrays => Linker_Package.Decl.Arrays,
In_Tree => Data.Tree); Shared => Shared);
if Switches = No_Array_Element then if Switches = No_Array_Element then
Switches := Switches :=
Value_Of Value_Of
(Name => Name_Default_Switches, (Name => Name_Default_Switches,
In_Arrays => Linker_Package.Decl.Arrays, In_Arrays => Linker_Package.Decl.Arrays,
In_Tree => Data.Tree); Shared => Shared);
end if; end if;
if Switches /= No_Array_Element then if Switches /= No_Array_Element then
...@@ -4310,6 +4322,8 @@ package body Prj.Nmsc is ...@@ -4310,6 +4322,8 @@ package body Prj.Nmsc is
(Project : Project_Id; (Project : Project_Id;
Data : in out Tree_Processing_Data) Data : in out Tree_Processing_Data)
is is
Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
Languages : Variable_Value := Nil_Variable_Value; Languages : Variable_Value := Nil_Variable_Value;
Def_Lang : Variable_Value := Nil_Variable_Value; Def_Lang : Variable_Value := Nil_Variable_Value;
Def_Lang_Id : Name_Id; Def_Lang_Id : Name_Id;
...@@ -4354,10 +4368,10 @@ package body Prj.Nmsc is ...@@ -4354,10 +4368,10 @@ package body Prj.Nmsc is
begin begin
Project.Languages := null; Project.Languages := null;
Languages := Languages :=
Prj.Util.Value_Of (Name_Languages, Project.Decl.Attributes, Data.Tree); Prj.Util.Value_Of (Name_Languages, Project.Decl.Attributes, Shared);
Def_Lang := Def_Lang :=
Prj.Util.Value_Of Prj.Util.Value_Of
(Name_Default_Language, Project.Decl.Attributes, Data.Tree); (Name_Default_Language, Project.Decl.Attributes, Shared);
if Project.Source_Dirs /= Nil_String then if Project.Source_Dirs /= Nil_String then
...@@ -4411,7 +4425,7 @@ package body Prj.Nmsc is ...@@ -4411,7 +4425,7 @@ package body Prj.Nmsc is
-- Languages. -- Languages.
while Current /= Nil_String loop while Current /= Nil_String loop
Element := Data.Tree.String_Elements.Table (Current); Element := Shared.String_Elements.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));
...@@ -4435,41 +4449,43 @@ package body Prj.Nmsc is ...@@ -4435,41 +4449,43 @@ package body Prj.Nmsc is
(Project : Project_Id; (Project : Project_Id;
Data : in out Tree_Processing_Data) Data : in out Tree_Processing_Data)
is is
Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
Lib_Interfaces : constant Prj.Variable_Value := Lib_Interfaces : constant Prj.Variable_Value :=
Prj.Util.Value_Of Prj.Util.Value_Of
(Snames.Name_Library_Interface, (Snames.Name_Library_Interface,
Project.Decl.Attributes, Project.Decl.Attributes,
Data.Tree); Shared);
Lib_Auto_Init : constant Prj.Variable_Value := Lib_Auto_Init : constant Prj.Variable_Value :=
Prj.Util.Value_Of Prj.Util.Value_Of
(Snames.Name_Library_Auto_Init, (Snames.Name_Library_Auto_Init,
Project.Decl.Attributes, Project.Decl.Attributes,
Data.Tree); Shared);
Lib_Src_Dir : constant Prj.Variable_Value := Lib_Src_Dir : constant Prj.Variable_Value :=
Prj.Util.Value_Of Prj.Util.Value_Of
(Snames.Name_Library_Src_Dir, (Snames.Name_Library_Src_Dir,
Project.Decl.Attributes, Project.Decl.Attributes,
Data.Tree); Shared);
Lib_Symbol_File : constant Prj.Variable_Value := Lib_Symbol_File : constant Prj.Variable_Value :=
Prj.Util.Value_Of Prj.Util.Value_Of
(Snames.Name_Library_Symbol_File, (Snames.Name_Library_Symbol_File,
Project.Decl.Attributes, Project.Decl.Attributes,
Data.Tree); Shared);
Lib_Symbol_Policy : constant Prj.Variable_Value := Lib_Symbol_Policy : constant Prj.Variable_Value :=
Prj.Util.Value_Of Prj.Util.Value_Of
(Snames.Name_Library_Symbol_Policy, (Snames.Name_Library_Symbol_Policy,
Project.Decl.Attributes, Project.Decl.Attributes,
Data.Tree); Shared);
Lib_Ref_Symbol_File : constant Prj.Variable_Value := Lib_Ref_Symbol_File : constant Prj.Variable_Value :=
Prj.Util.Value_Of Prj.Util.Value_Of
(Snames.Name_Library_Reference_Symbol_File, (Snames.Name_Library_Reference_Symbol_File,
Project.Decl.Attributes, Project.Decl.Attributes,
Data.Tree); Shared);
Auto_Init_Supported : Boolean; Auto_Init_Supported : Boolean;
OK : Boolean := True; OK : Boolean := True;
...@@ -4508,14 +4524,14 @@ package body Prj.Nmsc is ...@@ -4508,14 +4524,14 @@ package body Prj.Nmsc is
while Interfaces /= Nil_String loop while Interfaces /= Nil_String loop
Get_Name_String Get_Name_String
(Data.Tree.String_Elements.Table (Interfaces).Value); (Shared.String_Elements.Table (Interfaces).Value);
To_Lower (Name_Buffer (1 .. Name_Len)); To_Lower (Name_Buffer (1 .. Name_Len));
if Name_Len = 0 then if Name_Len = 0 then
Error_Msg Error_Msg
(Data.Flags, (Data.Flags,
"an interface cannot be an empty string", "an interface cannot be an empty string",
Data.Tree.String_Elements.Table (Interfaces).Location, Shared.String_Elements.Table (Interfaces).Location,
Project); Project);
else else
...@@ -4564,8 +4580,8 @@ package body Prj.Nmsc is ...@@ -4564,8 +4580,8 @@ package body Prj.Nmsc is
Error_Msg Error_Msg
(Data.Flags, (Data.Flags,
"%% is not a unit of this project", "%% is not a unit of this project",
Data.Tree.String_Elements.Table Shared.String_Elements.Table (Interfaces).Location,
(Interfaces).Location, Project); Project);
else else
if Source.Kind = Spec if Source.Kind = Spec
...@@ -4575,27 +4591,24 @@ package body Prj.Nmsc is ...@@ -4575,27 +4591,24 @@ package body Prj.Nmsc is
end if; end if;
String_Element_Table.Increment_Last String_Element_Table.Increment_Last
(Data.Tree.String_Elements); (Shared.String_Elements);
Data.Tree.String_Elements.Table Shared.String_Elements.Table
(String_Element_Table.Last (String_Element_Table.Last (Shared.String_Elements)) :=
(Data.Tree.String_Elements)) :=
(Value => Name_Id (Source.Dep_Name), (Value => Name_Id (Source.Dep_Name),
Index => 0, Index => 0,
Display_Value => Name_Id (Source.Dep_Name), Display_Value => Name_Id (Source.Dep_Name),
Location => Location =>
Data.Tree.String_Elements.Table Shared.String_Elements.Table (Interfaces).Location,
(Interfaces).Location,
Flag => False, Flag => False,
Next => Interface_ALIs); Next => Interface_ALIs);
Interface_ALIs := Interface_ALIs :=
String_Element_Table.Last String_Element_Table.Last (Shared.String_Elements);
(Data.Tree.String_Elements);
end if; end if;
end if; end if;
Interfaces := Data.Tree.String_Elements.Table (Interfaces).Next; Interfaces := Shared.String_Elements.Table (Interfaces).Next;
end loop; end loop;
-- Put the list of Interface ALIs in the project data -- Put the list of Interface ALIs in the project data
...@@ -4703,7 +4716,7 @@ package body Prj.Nmsc is ...@@ -4703,7 +4716,7 @@ package body Prj.Nmsc is
Src_Dirs := Project.Source_Dirs; Src_Dirs := Project.Source_Dirs;
while Src_Dirs /= Nil_String loop while Src_Dirs /= Nil_String loop
Src_Dir := Data.Tree.String_Elements.Table (Src_Dirs); Src_Dir := Shared.String_Elements.Table (Src_Dirs);
-- Report error if it is one of the source directories -- Report error if it is one of the source directories
...@@ -4734,7 +4747,7 @@ package body Prj.Nmsc is ...@@ -4734,7 +4747,7 @@ package body Prj.Nmsc is
Src_Dirs := Pid.Project.Source_Dirs; Src_Dirs := Pid.Project.Source_Dirs;
Dir_Loop : while Src_Dirs /= Nil_String loop Dir_Loop : while Src_Dirs /= Nil_String loop
Src_Dir := Src_Dir :=
Data.Tree.String_Elements.Table (Src_Dirs); Shared.String_Elements.Table (Src_Dirs);
-- Report error if it is one of the source -- Report error if it is one of the source
-- directories. -- directories.
...@@ -5002,41 +5015,43 @@ package body Prj.Nmsc is ...@@ -5002,41 +5015,43 @@ package body Prj.Nmsc is
(Project : Project_Id; (Project : Project_Id;
Data : in out Tree_Processing_Data) Data : in out Tree_Processing_Data)
is is
Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
Object_Dir : constant Variable_Value := Object_Dir : constant Variable_Value :=
Util.Value_Of Util.Value_Of
(Name_Object_Dir, Project.Decl.Attributes, Data.Tree); (Name_Object_Dir, Project.Decl.Attributes, Shared);
Exec_Dir : constant Variable_Value := Exec_Dir : constant Variable_Value :=
Util.Value_Of Util.Value_Of
(Name_Exec_Dir, Project.Decl.Attributes, Data.Tree); (Name_Exec_Dir, Project.Decl.Attributes, Shared);
Source_Dirs : constant Variable_Value := Source_Dirs : constant Variable_Value :=
Util.Value_Of Util.Value_Of
(Name_Source_Dirs, Project.Decl.Attributes, Data.Tree); (Name_Source_Dirs, Project.Decl.Attributes, Shared);
Ignore_Source_Sub_Dirs : constant Variable_Value := Ignore_Source_Sub_Dirs : constant Variable_Value :=
Util.Value_Of Util.Value_Of
(Name_Ignore_Source_Sub_Dirs, (Name_Ignore_Source_Sub_Dirs,
Project.Decl.Attributes, Project.Decl.Attributes,
Data.Tree); Shared);
Excluded_Source_Dirs : constant Variable_Value := Excluded_Source_Dirs : constant Variable_Value :=
Util.Value_Of Util.Value_Of
(Name_Excluded_Source_Dirs, (Name_Excluded_Source_Dirs,
Project.Decl.Attributes, Project.Decl.Attributes,
Data.Tree); Shared);
Source_Files : constant Variable_Value := Source_Files : constant Variable_Value :=
Util.Value_Of Util.Value_Of
(Name_Source_Files, (Name_Source_Files,
Project.Decl.Attributes, Data.Tree); Project.Decl.Attributes, Shared);
Last_Source_Dir : String_List_Id := Nil_String; Last_Source_Dir : String_List_Id := Nil_String;
Last_Src_Dir_Rank : Number_List_Index := No_Number_List; Last_Src_Dir_Rank : Number_List_Index := No_Number_List;
Languages : constant Variable_Value := Languages : constant Variable_Value :=
Prj.Util.Value_Of Prj.Util.Value_Of
(Name_Languages, Project.Decl.Attributes, Data.Tree); (Name_Languages, Project.Decl.Attributes, Shared);
Remove_Source_Dirs : Boolean := False; Remove_Source_Dirs : Boolean := False;
...@@ -5070,12 +5085,12 @@ package body Prj.Nmsc is ...@@ -5070,12 +5085,12 @@ package body Prj.Nmsc is
List := Project.Source_Dirs; List := Project.Source_Dirs;
Rank_List := Project.Source_Dir_Ranks; Rank_List := Project.Source_Dir_Ranks;
while List /= Nil_String loop while List /= Nil_String loop
Element := Data.Tree.String_Elements.Table (List); Element := Shared.String_Elements.Table (List);
exit when Element.Value = Name_Id (Path.Name); exit when Element.Value = Name_Id (Path.Name);
Prev := List; Prev := List;
List := Element.Next; List := Element.Next;
Prev_Rank := Rank_List; Prev_Rank := Rank_List;
Rank_List := Data.Tree.Number_Lists.Table (Prev_Rank).Next; Rank_List := Shared.Number_Lists.Table (Prev_Rank).Next;
end loop; end loop;
-- The directory is in the list if List is not Nil_String -- The directory is in the list if List is not Nil_String
...@@ -5083,7 +5098,7 @@ package body Prj.Nmsc is ...@@ -5083,7 +5098,7 @@ package body Prj.Nmsc is
if not Remove_Source_Dirs and then List = Nil_String then if not Remove_Source_Dirs and then List = Nil_String then
Debug_Output ("Adding source dir=", Name_Id (Path.Display_Name)); Debug_Output ("Adding source dir=", Name_Id (Path.Display_Name));
String_Element_Table.Increment_Last (Data.Tree.String_Elements); String_Element_Table.Increment_Last (Shared.String_Elements);
Element := Element :=
(Value => Name_Id (Path.Name), (Value => Name_Id (Path.Name),
Index => 0, Index => 0,
...@@ -5092,35 +5107,34 @@ package body Prj.Nmsc is ...@@ -5092,35 +5107,34 @@ package body Prj.Nmsc is
Flag => False, Flag => False,
Next => Nil_String); Next => Nil_String);
Number_List_Table.Increment_Last (Data.Tree.Number_Lists); Number_List_Table.Increment_Last (Shared.Number_Lists);
if Last_Source_Dir = Nil_String then if Last_Source_Dir = Nil_String then
-- This is the first source directory -- This is the first source directory
Project.Source_Dirs := Project.Source_Dirs :=
String_Element_Table.Last (Data.Tree.String_Elements); String_Element_Table.Last (Shared.String_Elements);
Project.Source_Dir_Ranks := Project.Source_Dir_Ranks :=
Number_List_Table.Last (Data.Tree.Number_Lists); Number_List_Table.Last (Shared.Number_Lists);
else else
-- We already have source directories, link the previous -- We already have source directories, link the previous
-- last to the new one. -- last to the new one.
Data.Tree.String_Elements.Table (Last_Source_Dir).Next := Shared.String_Elements.Table (Last_Source_Dir).Next :=
String_Element_Table.Last (Data.Tree.String_Elements); String_Element_Table.Last (Shared.String_Elements);
Data.Tree.Number_Lists.Table (Last_Src_Dir_Rank).Next := Shared.Number_Lists.Table (Last_Src_Dir_Rank).Next :=
Number_List_Table.Last (Data.Tree.Number_Lists); Number_List_Table.Last (Shared.Number_Lists);
end if; end if;
-- And register this source directory as the new last -- And register this source directory as the new last
Last_Source_Dir := Last_Source_Dir :=
String_Element_Table.Last (Data.Tree.String_Elements); String_Element_Table.Last (Shared.String_Elements);
Data.Tree.String_Elements.Table (Last_Source_Dir) := Element; Shared.String_Elements.Table (Last_Source_Dir) := Element;
Last_Src_Dir_Rank := Last_Src_Dir_Rank := Number_List_Table.Last (Shared.Number_Lists);
Number_List_Table.Last (Data.Tree.Number_Lists); Shared.Number_Lists.Table (Last_Src_Dir_Rank) :=
Data.Tree.Number_Lists.Table (Last_Src_Dir_Rank) :=
(Number => Rank, Next => No_Number_List); (Number => Rank, Next => No_Number_List);
elsif Remove_Source_Dirs and then List /= Nil_String then elsif Remove_Source_Dirs and then List /= Nil_String then
...@@ -5128,16 +5142,15 @@ package body Prj.Nmsc is ...@@ -5128,16 +5142,15 @@ package body Prj.Nmsc is
-- Remove source dir if present -- Remove source dir if present
if Prev = Nil_String then if Prev = Nil_String then
Project.Source_Dirs := Project.Source_Dirs := Shared.String_Elements.Table (List).Next;
Data.Tree.String_Elements.Table (List).Next;
Project.Source_Dir_Ranks := Project.Source_Dir_Ranks :=
Data.Tree.Number_Lists.Table (Rank_List).Next; Shared.Number_Lists.Table (Rank_List).Next;
else else
Data.Tree.String_Elements.Table (Prev).Next := Shared.String_Elements.Table (Prev).Next :=
Data.Tree.String_Elements.Table (List).Next; Shared.String_Elements.Table (List).Next;
Data.Tree.Number_Lists.Table (Prev_Rank).Next := Shared.Number_Lists.Table (Prev_Rank).Next :=
Data.Tree.Number_Lists.Table (Rank_List).Next; Shared.Number_Lists.Table (Rank_List).Next;
end if; end if;
end if; end if;
end Add_To_Or_Remove_From_Source_Dirs; end Add_To_Or_Remove_From_Source_Dirs;
...@@ -5357,11 +5370,11 @@ package body Prj.Nmsc is ...@@ -5357,11 +5370,11 @@ package body Prj.Nmsc is
begin begin
while Current /= Nil_String loop while Current /= Nil_String loop
Element := Data.Tree.String_Elements.Table (Current); Element := Shared.String_Elements.Table (Current);
if Element.Value /= No_Name then if Element.Value /= No_Name then
Element.Value := Element.Value :=
Name_Id (Canonical_Case_File_Name (Element.Value)); Name_Id (Canonical_Case_File_Name (Element.Value));
Data.Tree.String_Elements.Table (Current) := Element; Shared.String_Elements.Table (Current) := Element;
end if; end if;
Current := Element.Next; Current := Element.Next;
...@@ -5377,9 +5390,11 @@ package body Prj.Nmsc is ...@@ -5377,9 +5390,11 @@ package body Prj.Nmsc is
(Project : Project_Id; (Project : Project_Id;
Data : in out Tree_Processing_Data) Data : in out Tree_Processing_Data)
is is
Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
Mains : constant Variable_Value := Mains : constant Variable_Value :=
Prj.Util.Value_Of Prj.Util.Value_Of
(Name_Main, Project.Decl.Attributes, Data.Tree); (Name_Main, Project.Decl.Attributes, Shared);
List : String_List_Id; List : String_List_Id;
Elem : String_Element; Elem : String_Element;
...@@ -5405,7 +5420,7 @@ package body Prj.Nmsc is ...@@ -5405,7 +5420,7 @@ package body Prj.Nmsc is
else else
List := Mains.Values; List := Mains.Values;
while List /= Nil_String loop while List /= Nil_String loop
Elem := Data.Tree.String_Elements.Table (List); Elem := Shared.String_Elements.Table (List);
if Length_Of_Name (Elem.Value) = 0 then if Length_Of_Name (Elem.Value) = 0 then
Error_Msg Error_Msg
...@@ -5972,15 +5987,17 @@ package body Prj.Nmsc is ...@@ -5972,15 +5987,17 @@ package body Prj.Nmsc is
(Project : in out Project_Processing_Data; (Project : in out Project_Processing_Data;
Data : in out Tree_Processing_Data) Data : in out Tree_Processing_Data)
is is
Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
Excluded_Source_List_File : constant Variable_Value := Excluded_Source_List_File : constant Variable_Value :=
Util.Value_Of Util.Value_Of
(Name_Excluded_Source_List_File, (Name_Excluded_Source_List_File,
Project.Project.Decl.Attributes, Project.Project.Decl.Attributes,
Data.Tree); Shared);
Excluded_Sources : Variable_Value := Util.Value_Of Excluded_Sources : Variable_Value := Util.Value_Of
(Name_Excluded_Source_Files, (Name_Excluded_Source_Files,
Project.Project.Decl.Attributes, Project.Project.Decl.Attributes,
Data.Tree); Shared);
Current : String_List_Id; Current : String_List_Id;
Element : String_Element; Element : String_Element;
...@@ -5999,7 +6016,7 @@ package body Prj.Nmsc is ...@@ -5999,7 +6016,7 @@ package body Prj.Nmsc is
Excluded_Sources := Excluded_Sources :=
Util.Value_Of Util.Value_Of
(Name_Locally_Removed_Files, (Name_Locally_Removed_Files,
Project.Project.Decl.Attributes, Data.Tree); Project.Project.Decl.Attributes, Shared);
end if; end if;
-- If there are excluded sources, put them in the table -- If there are excluded sources, put them in the table
...@@ -6023,7 +6040,7 @@ package body Prj.Nmsc is ...@@ -6023,7 +6040,7 @@ package body Prj.Nmsc is
Current := Excluded_Sources.Values; Current := Excluded_Sources.Values;
while Current /= Nil_String loop while Current /= Nil_String loop
Element := Data.Tree.String_Elements.Table (Current); Element := Shared.String_Elements.Table (Current);
Name := Canonical_Case_File_Name (Element.Value); Name := Canonical_Case_File_Name (Element.Value);
-- If the element has no location, then use the location of -- If the element has no location, then use the location of
...@@ -6129,17 +6146,19 @@ package body Prj.Nmsc is ...@@ -6129,17 +6146,19 @@ package body Prj.Nmsc is
(Project : in out Project_Processing_Data; (Project : in out Project_Processing_Data;
Data : in out Tree_Processing_Data) Data : in out Tree_Processing_Data)
is is
Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
Sources : constant Variable_Value := Sources : constant Variable_Value :=
Util.Value_Of Util.Value_Of
(Name_Source_Files, (Name_Source_Files,
Project.Project.Decl.Attributes, Project.Project.Decl.Attributes,
Data.Tree); Shared);
Source_List_File : constant Variable_Value := Source_List_File : constant Variable_Value :=
Util.Value_Of Util.Value_Of
(Name_Source_List_File, (Name_Source_List_File,
Project.Project.Decl.Attributes, Project.Project.Decl.Attributes,
Data.Tree); Shared);
Name_Loc : Name_Location; Name_Loc : Name_Location;
Has_Explicit_Sources : Boolean; Has_Explicit_Sources : Boolean;
...@@ -6188,7 +6207,7 @@ package body Prj.Nmsc is ...@@ -6188,7 +6207,7 @@ package body Prj.Nmsc is
end if; end if;
while Current /= Nil_String loop while Current /= Nil_String loop
Element := Data.Tree.String_Elements.Table (Current); Element := Shared.String_Elements.Table (Current);
Name := Canonical_Case_File_Name (Element.Value); Name := Canonical_Case_File_Name (Element.Value);
Get_Name_String (Element.Value); Get_Name_String (Element.Value);
...@@ -6810,6 +6829,8 @@ package body Prj.Nmsc is ...@@ -6810,6 +6829,8 @@ package body Prj.Nmsc is
Search_For : Search_Type; Search_For : Search_Type;
Resolve_Links : Boolean) Resolve_Links : Boolean)
is is
Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
package Recursive_Dirs is new GNAT.Dynamic_HTables.Simple_HTable package Recursive_Dirs is new GNAT.Dynamic_HTables.Simple_HTable
(Header_Num => Header_Num, (Header_Num => Header_Num,
Element => Boolean, Element => Boolean,
...@@ -6950,13 +6971,12 @@ package body Prj.Nmsc is ...@@ -6950,13 +6971,12 @@ package body Prj.Nmsc is
while List /= Nil_String loop while List /= Nil_String loop
Get_Name_String Get_Name_String
(Data.Tree.String_Elements.Table (List).Value); (Shared.String_Elements.Table (List).Value);
Canonical_Case_File_Name Canonical_Case_File_Name
(Name_Buffer (1 .. Name_Len)); (Name_Buffer (1 .. Name_Len));
OK := Name_Buffer (1 .. Name_Len) /= Dir_Name; OK := Name_Buffer (1 .. Name_Len) /= Dir_Name;
exit when not OK; exit when not OK;
List := List := Shared.String_Elements.Table (List).Next;
Data.Tree.String_Elements.Table (List).Next;
end loop; end loop;
end; end;
end if; end if;
...@@ -7116,7 +7136,7 @@ package body Prj.Nmsc is ...@@ -7116,7 +7136,7 @@ package body Prj.Nmsc is
begin begin
while Pattern_Id /= Nil_String loop while Pattern_Id /= Nil_String loop
Element := Data.Tree.String_Elements.Table (Pattern_Id); Element := Shared.String_Elements.Table (Pattern_Id);
Find_Pattern (Element.Value, Rank, Element.Location); Find_Pattern (Element.Value, Rank, Element.Location);
Rank := Rank + 1; Rank := Rank + 1;
Pattern_Id := Element.Next; Pattern_Id := Element.Next;
...@@ -7134,6 +7154,8 @@ package body Prj.Nmsc is ...@@ -7134,6 +7154,8 @@ package body Prj.Nmsc is
Data : in out Tree_Processing_Data; Data : in out Tree_Processing_Data;
For_All_Sources : Boolean) For_All_Sources : Boolean)
is is
Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
Source_Dir : String_List_Id; Source_Dir : String_List_Id;
Element : String_Element; Element : String_Element;
Src_Dir_Rank : Number_List_Index; Src_Dir_Rank : Number_List_Index;
...@@ -7153,8 +7175,8 @@ package body Prj.Nmsc is ...@@ -7153,8 +7175,8 @@ package body Prj.Nmsc is
Src_Dir_Rank := Project.Project.Source_Dir_Ranks; Src_Dir_Rank := Project.Project.Source_Dir_Ranks;
while Source_Dir /= Nil_String loop while Source_Dir /= Nil_String loop
begin begin
Num_Nod := Data.Tree.Number_Lists.Table (Src_Dir_Rank); Num_Nod := Shared.Number_Lists.Table (Src_Dir_Rank);
Element := Data.Tree.String_Elements.Table (Source_Dir); Element := Shared.String_Elements.Table (Source_Dir);
-- Use Element.Value in this test, not Display_Value, because we -- Use Element.Value in this test, not Display_Value, because we
-- want the symbolic links to be resolved when appropriate. -- want the symbolic links to be resolved when appropriate.
...@@ -7932,7 +7954,7 @@ package body Prj.Nmsc is ...@@ -7932,7 +7954,7 @@ package body Prj.Nmsc is
procedure Show_Source_Dirs procedure Show_Source_Dirs
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref) Shared : Shared_Project_Tree_Data_Access)
is is
Current : String_List_Id; Current : String_List_Id;
Element : String_Element; Element : String_Element;
...@@ -7945,7 +7967,7 @@ package body Prj.Nmsc is ...@@ -7945,7 +7967,7 @@ package body Prj.Nmsc is
Current := Project.Source_Dirs; Current := Project.Source_Dirs;
while Current /= Nil_String loop while Current /= Nil_String loop
Element := In_Tree.String_Elements.Table (Current); Element := Shared.String_Elements.Table (Current);
Debug_Output (Get_Name_String (Element.Display_Value)); Debug_Output (Get_Name_String (Element.Display_Value));
Current := Element.Next; Current := Element.Next;
end loop; end loop;
...@@ -7965,8 +7987,9 @@ package body Prj.Nmsc is ...@@ -7965,8 +7987,9 @@ package body Prj.Nmsc is
Flags : Processing_Flags) Flags : Processing_Flags)
is is
procedure Recursive_Check procedure Recursive_Check
(Project : Project_Id; (Project : Project_Id;
Data : in out Tree_Processing_Data); Prj_Tree : Project_Tree_Ref;
Data : in out Tree_Processing_Data);
-- Check_Naming_Scheme for the project -- Check_Naming_Scheme for the project
--------------------- ---------------------
...@@ -7974,17 +7997,21 @@ package body Prj.Nmsc is ...@@ -7974,17 +7997,21 @@ package body Prj.Nmsc is
--------------------- ---------------------
procedure Recursive_Check procedure Recursive_Check
(Project : Project_Id; (Project : Project_Id;
Data : in out Tree_Processing_Data) Prj_Tree : Project_Tree_Ref;
is Data : in out Tree_Processing_Data) is
begin begin
if Verbose_Mode then if Current_Verbosity = High then
Write_Str ("Processing_Naming_Scheme for project """); Debug_Increase_Indent
Write_Str (Get_Name_String (Project.Name)); ("Processing_Naming_Scheme for project", Project.Name);
Write_Line ("""");
end if; end if;
Data.Tree := Prj_Tree;
Prj.Nmsc.Check (Project, Data); Prj.Nmsc.Check (Project, Data);
if Current_Verbosity = High then
Debug_Decrease_Indent ("Done Processing_Naming_Scheme");
end if;
end Recursive_Check; end Recursive_Check;
procedure Check_All_Projects is new procedure Check_All_Projects is new
...@@ -7996,7 +8023,7 @@ package body Prj.Nmsc is ...@@ -7996,7 +8023,7 @@ package body Prj.Nmsc is
begin begin
Lib_Data_Table.Init; Lib_Data_Table.Init;
Initialize (Data, Tree => Tree, Node_Tree => Node_Tree, Flags => Flags); Initialize (Data, Tree => Tree, Node_Tree => Node_Tree, Flags => Flags);
Check_All_Projects (Root_Project, Data, Imported_First => True); Check_All_Projects (Root_Project, Tree, Data, Imported_First => True);
Free (Data); Free (Data);
-- Adjust language configs for projects that are extended -- Adjust language configs for projects that are extended
......
gcc/ada/prj-proc.adb
...@@ -71,7 +71,7 @@ package body Prj.Proc is ...@@ -71,7 +71,7 @@ package body Prj.Proc is
(Project : Project_Id; (Project : Project_Id;
Project_Name : Name_Id; Project_Name : Name_Id;
Project_Dir : Name_Id; Project_Dir : Name_Id;
In_Tree : Project_Tree_Ref; Shared : Shared_Project_Tree_Data_Access;
Decl : in out Declarations; Decl : in out Declarations;
First : Attribute_Node_Id; First : Attribute_Node_Id;
Project_Level : Boolean); Project_Level : Boolean);
...@@ -95,7 +95,7 @@ package body Prj.Proc is ...@@ -95,7 +95,7 @@ package body Prj.Proc is
To : in out Declarations; To : in out Declarations;
New_Loc : Source_Ptr; New_Loc : Source_Ptr;
Restricted : Boolean; Restricted : Boolean;
In_Tree : Project_Tree_Ref); Shared : Shared_Project_Tree_Data_Access);
-- Copy a package declaration From to To for a renamed package. Change the -- Copy a package declaration From to To for a renamed package. Change the
-- locations of all the attributes to New_Loc. When Restricted is -- locations of all the attributes to New_Loc. When Restricted is
-- True, do not copy attributes Body, Spec, Implementation, Specification -- True, do not copy attributes Body, Spec, Implementation, Specification
...@@ -103,7 +103,7 @@ package body Prj.Proc is ...@@ -103,7 +103,7 @@ package body Prj.Proc is
function Expression function Expression
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref; Shared : Shared_Project_Tree_Data_Access;
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 : Prj.Tree.Environment; Env : Prj.Tree.Environment;
...@@ -120,29 +120,26 @@ package body Prj.Proc is ...@@ -120,29 +120,26 @@ package body Prj.Proc is
function Package_From function Package_From
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref; Shared : Shared_Project_Tree_Data_Access;
With_Name : Name_Id) return Package_Id; With_Name : Name_Id) return Package_Id;
-- Find the package of Project whose name is With_Name -- Find the package of Project whose name is With_Name
procedure Process_Declarative_Items procedure Process_Declarative_Items
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
From_Project_Node : Project_Node_Id; From_Project_Node : Project_Node_Id;
Node_Tree : Project_Node_Tree_Ref; Node_Tree : Project_Node_Tree_Ref;
Env : Prj.Tree.Environment; Env : Prj.Tree.Environment;
Pkg : Package_Id; Pkg : Package_Id;
Item : Project_Node_Id; Item : Project_Node_Id;
Child_Env : in out Prj.Tree.Environment; Child_Env : in out Prj.Tree.Environment);
Can_Modify_Child_Env : Boolean);
-- Process declarative items starting with From_Project_Node, and put them -- Process declarative items starting with From_Project_Node, and put them
-- in declarations Decl. This is a recursive procedure; it calls itself for -- in declarations Decl. This is a recursive procedure; it calls itself for
-- a package declaration or a case construction. -- a package declaration or a case construction.
-- --
-- Child_Env is the modified environment after seeing declarations like -- Child_Env is the modified environment after seeing declarations like
-- "for External(...) use" or "for Project_Path use" in aggregate projects. -- "for External(...) use" or "for Project_Path use" in aggregate projects.
-- It should have been initialized first. This environment can only be -- It should have been initialized first.
-- modified if Can_Modify_Child_Env is True, otherwise all the above
-- attributes simply have no effect.
procedure Recursive_Process procedure Recursive_Process
(In_Tree : Project_Tree_Ref; (In_Tree : Project_Tree_Ref;
...@@ -150,20 +147,13 @@ package body Prj.Proc is ...@@ -150,20 +147,13 @@ package body 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;
Extended_By : Project_Id; Extended_By : Project_Id);
Child_Env : in out Prj.Tree.Environment;
Is_Root_Project : Boolean);
-- Process project with node From_Project_Node in the tree. Do nothing if -- Process project with node From_Project_Node in the tree. Do nothing if
-- From_Project_Node is Empty_Node. If project has already been processed, -- From_Project_Node is Empty_Node. If project has already been processed,
-- simply return its project id. Otherwise create a new project id, mark it -- simply return its project id. Otherwise create a new project id, mark it
-- as processed, call itself recursively for all imported projects and a -- as processed, call itself recursively for all imported projects and a
-- extended project, if any. Then process the declarative items of the -- extended project, if any. Then process the declarative items of the
-- project. -- project.
--
-- Child_Env is the environment created from an aggregate project (new
-- external values or project path), and should be initialized before the
-- call.
--
-- Is_Root_Project should be true only for the project that the user -- Is_Root_Project should be true only for the project that the user
-- explicitly loaded. In the context of aggregate projects, only that -- explicitly loaded. In the context of aggregate projects, only that
-- project is allowed to modify the environment that will be used to load -- project is allowed to modify the environment that will be used to load
...@@ -209,7 +199,7 @@ package body Prj.Proc is ...@@ -209,7 +199,7 @@ package body Prj.Proc is
(Project : Project_Id; (Project : Project_Id;
Project_Name : Name_Id; Project_Name : Name_Id;
Project_Dir : Name_Id; Project_Dir : Name_Id;
In_Tree : Project_Tree_Ref; Shared : Shared_Project_Tree_Data_Access;
Decl : in out Declarations; Decl : in out Declarations;
First : Attribute_Node_Id; First : Attribute_Node_Id;
Project_Level : Boolean) Project_Level : Boolean)
...@@ -272,15 +262,14 @@ package body Prj.Proc is ...@@ -272,15 +262,14 @@ package body Prj.Proc is
end case; end case;
Variable_Element_Table.Increment_Last Variable_Element_Table.Increment_Last
(In_Tree.Variable_Elements); (Shared.Variable_Elements);
In_Tree.Variable_Elements.Table Shared.Variable_Elements.Table
(Variable_Element_Table.Last (Variable_Element_Table.Last (Shared.Variable_Elements)) :=
(In_Tree.Variable_Elements)) :=
(Next => Decl.Attributes, (Next => Decl.Attributes,
Name => Attribute_Name_Of (The_Attribute), Name => Attribute_Name_Of (The_Attribute),
Value => New_Attribute); Value => New_Attribute);
Decl.Attributes := Variable_Element_Table.Last Decl.Attributes := Variable_Element_Table.Last
(In_Tree.Variable_Elements); (Shared.Variable_Elements);
end; end;
end if; end if;
...@@ -342,7 +331,7 @@ package body Prj.Proc is ...@@ -342,7 +331,7 @@ package body Prj.Proc is
To : in out Declarations; To : in out Declarations;
New_Loc : Source_Ptr; New_Loc : Source_Ptr;
Restricted : Boolean; Restricted : Boolean;
In_Tree : Project_Tree_Ref) Shared : Shared_Project_Tree_Data_Access)
is is
V1 : Variable_Id; V1 : Variable_Id;
V2 : Variable_Id := No_Variable; V2 : Variable_Id := No_Variable;
...@@ -367,7 +356,7 @@ package body Prj.Proc is ...@@ -367,7 +356,7 @@ package body Prj.Proc is
-- Copy the attribute -- Copy the attribute
Var := In_Tree.Variable_Elements.Table (V1); Var := Shared.Variable_Elements.Table (V1);
V1 := Var.Next; V1 := Var.Next;
-- Do not copy the value of attribute Linker_Options if Restricted -- Do not copy the value of attribute Linker_Options if Restricted
...@@ -383,27 +372,27 @@ package body Prj.Proc is ...@@ -383,27 +372,27 @@ package body Prj.Proc is
-- Change the location to New_Loc -- Change the location to New_Loc
Var.Value.Location := New_Loc; Var.Value.Location := New_Loc;
Variable_Element_Table.Increment_Last (In_Tree.Variable_Elements); Variable_Element_Table.Increment_Last (Shared.Variable_Elements);
-- Put in new declaration -- Put in new declaration
if To.Attributes = No_Variable then if To.Attributes = No_Variable then
To.Attributes := To.Attributes :=
Variable_Element_Table.Last (In_Tree.Variable_Elements); Variable_Element_Table.Last (Shared.Variable_Elements);
else else
In_Tree.Variable_Elements.Table (V2).Next := Shared.Variable_Elements.Table (V2).Next :=
Variable_Element_Table.Last (In_Tree.Variable_Elements); Variable_Element_Table.Last (Shared.Variable_Elements);
end if; end if;
V2 := Variable_Element_Table.Last (In_Tree.Variable_Elements); V2 := Variable_Element_Table.Last (Shared.Variable_Elements);
In_Tree.Variable_Elements.Table (V2) := Var; Shared.Variable_Elements.Table (V2) := Var;
end loop; end loop;
-- Then the associated array attributes -- Then the associated array attributes
A1 := From.Arrays; A1 := From.Arrays;
while A1 /= No_Array loop while A1 /= No_Array loop
Arr := In_Tree.Arrays.Table (A1); Arr := Shared.Arrays.Table (A1);
A1 := Arr.Next; A1 := Arr.Next;
if not Restricted if not Restricted
...@@ -416,18 +405,18 @@ package body Prj.Proc is ...@@ -416,18 +405,18 @@ package body Prj.Proc is
-- Remove the Next component -- Remove the Next component
Arr.Next := No_Array; Arr.Next := No_Array;
Array_Table.Increment_Last (In_Tree.Arrays); Array_Table.Increment_Last (Shared.Arrays);
-- Create new Array declaration -- Create new Array declaration
if To.Arrays = No_Array then if To.Arrays = No_Array then
To.Arrays := Array_Table.Last (In_Tree.Arrays); To.Arrays := Array_Table.Last (Shared.Arrays);
else else
In_Tree.Arrays.Table (A2).Next := Shared.Arrays.Table (A2).Next :=
Array_Table.Last (In_Tree.Arrays); Array_Table.Last (Shared.Arrays);
end if; end if;
A2 := Array_Table.Last (In_Tree.Arrays); A2 := Array_Table.Last (Shared.Arrays);
-- Don't store the array as its first element has not been set yet -- Don't store the array as its first element has not been set yet
...@@ -439,7 +428,7 @@ package body Prj.Proc is ...@@ -439,7 +428,7 @@ package body Prj.Proc is
-- Copy the array element -- Copy the array element
Elm := In_Tree.Array_Elements.Table (E1); Elm := Shared.Array_Elements.Table (E1);
E1 := Elm.Next; E1 := Elm.Next;
-- Remove the Next component -- Remove the Next component
...@@ -449,25 +438,25 @@ package body Prj.Proc is ...@@ -449,25 +438,25 @@ package body Prj.Proc is
-- Change the location -- Change the location
Elm.Value.Location := New_Loc; Elm.Value.Location := New_Loc;
Array_Element_Table.Increment_Last (In_Tree.Array_Elements); Array_Element_Table.Increment_Last (Shared.Array_Elements);
-- Create new array element -- Create new array element
if Arr.Value = No_Array_Element then if Arr.Value = No_Array_Element then
Arr.Value := Arr.Value :=
Array_Element_Table.Last (In_Tree.Array_Elements); Array_Element_Table.Last (Shared.Array_Elements);
else else
In_Tree.Array_Elements.Table (E2).Next := Shared.Array_Elements.Table (E2).Next :=
Array_Element_Table.Last (In_Tree.Array_Elements); Array_Element_Table.Last (Shared.Array_Elements);
end if; end if;
E2 := Array_Element_Table.Last (In_Tree.Array_Elements); E2 := Array_Element_Table.Last (Shared.Array_Elements);
In_Tree.Array_Elements.Table (E2) := Elm; Shared.Array_Elements.Table (E2) := Elm;
end loop; end loop;
-- Finally, store the new array -- Finally, store the new array
In_Tree.Arrays.Table (A2) := Arr; Shared.Arrays.Table (A2) := Arr;
end if; end if;
end loop; end loop;
end Copy_Package_Declarations; end Copy_Package_Declarations;
...@@ -499,7 +488,7 @@ package body Prj.Proc is ...@@ -499,7 +488,7 @@ package body Prj.Proc is
function Expression function Expression
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref; Shared : Shared_Project_Tree_Data_Access;
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 : Prj.Tree.Environment; Env : Prj.Tree.Environment;
...@@ -553,25 +542,25 @@ package body Prj.Proc is ...@@ -553,25 +542,25 @@ package body Prj.Proc is
when List => when List =>
String_Element_Table.Increment_Last String_Element_Table.Increment_Last
(In_Tree.String_Elements); (Shared.String_Elements);
if Last = Nil_String then if Last = Nil_String then
-- This can happen in an expression like () & "toto" -- This can happen in an expression like () & "toto"
Result.Values := String_Element_Table.Last Result.Values := String_Element_Table.Last
(In_Tree.String_Elements); (Shared.String_Elements);
else else
In_Tree.String_Elements.Table Shared.String_Elements.Table
(Last).Next := String_Element_Table.Last (Last).Next := String_Element_Table.Last
(In_Tree.String_Elements); (Shared.String_Elements);
end if; end if;
Last := String_Element_Table.Last Last := String_Element_Table.Last
(In_Tree.String_Elements); (Shared.String_Elements);
In_Tree.String_Elements.Table (Last) := Shared.String_Elements.Table (Last) :=
(Value => String_Value_Of (Value => String_Value_Of
(The_Current_Term, (The_Current_Term,
From_Project_Node_Tree), From_Project_Node_Tree),
...@@ -604,7 +593,7 @@ package body Prj.Proc is ...@@ -604,7 +593,7 @@ package body Prj.Proc is
Value := Expression Value := Expression
(Project => Project, (Project => Project,
In_Tree => In_Tree, Shared => Shared,
From_Project_Node => From_Project_Node, From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree, From_Project_Node_Tree => From_Project_Node_Tree,
Env => Env, Env => Env,
...@@ -614,26 +603,25 @@ package body Prj.Proc is ...@@ -614,26 +603,25 @@ package body Prj.Proc is
(String_Node, From_Project_Node_Tree), (String_Node, From_Project_Node_Tree),
Kind => Single); Kind => Single);
String_Element_Table.Increment_Last String_Element_Table.Increment_Last
(In_Tree.String_Elements); (Shared.String_Elements);
if Result.Values = Nil_String then if Result.Values = Nil_String then
-- This literal string list is the first term in a -- This literal string list is the first term in a
-- string list expression -- string list expression
Result.Values := Result.Values := String_Element_Table.Last
String_Element_Table.Last (In_Tree.String_Elements); (Shared.String_Elements);
else else
In_Tree.String_Elements.Table Shared.String_Elements.Table (Last).Next :=
(Last).Next := String_Element_Table.Last (Shared.String_Elements);
String_Element_Table.Last (In_Tree.String_Elements);
end if; end if;
Last := Last := String_Element_Table.Last
String_Element_Table.Last (In_Tree.String_Elements); (Shared.String_Elements);
In_Tree.String_Elements.Table (Last) := Shared.String_Elements.Table (Last) :=
(Value => Value.Value, (Value => Value.Value,
Display_Value => No_Name, Display_Value => No_Name,
Location => Value.Location, Location => Value.Location,
...@@ -654,7 +642,7 @@ package body Prj.Proc is ...@@ -654,7 +642,7 @@ package body Prj.Proc is
Value := Value :=
Expression Expression
(Project => Project, (Project => Project,
In_Tree => In_Tree, Shared => Shared,
From_Project_Node => From_Project_Node, From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree, From_Project_Node_Tree => From_Project_Node_Tree,
Env => Env, Env => Env,
...@@ -665,12 +653,12 @@ package body Prj.Proc is ...@@ -665,12 +653,12 @@ package body Prj.Proc is
Kind => Single); Kind => Single);
String_Element_Table.Increment_Last String_Element_Table.Increment_Last
(In_Tree.String_Elements); (Shared.String_Elements);
In_Tree.String_Elements.Table (Last).Next := Shared.String_Elements.Table (Last).Next :=
String_Element_Table.Last (In_Tree.String_Elements); String_Element_Table.Last (Shared.String_Elements);
Last := Last := String_Element_Table.Last
String_Element_Table.Last (In_Tree.String_Elements); (Shared.String_Elements);
In_Tree.String_Elements.Table (Last) := Shared.String_Elements.Table (Last) :=
(Value => Value.Value, (Value => Value.Value,
Display_Value => No_Name, Display_Value => No_Name,
Location => Value.Location, Location => Value.Location,
...@@ -721,11 +709,11 @@ package body Prj.Proc is ...@@ -721,11 +709,11 @@ package body Prj.Proc is
The_Package := The_Project.Decl.Packages; The_Package := The_Project.Decl.Packages;
while The_Package /= No_Package while The_Package /= No_Package
and then In_Tree.Packages.Table and then Shared.Packages.Table (The_Package).Name /=
(The_Package).Name /= The_Name The_Name
loop loop
The_Package := The_Package :=
In_Tree.Packages.Table (The_Package).Next; Shared.Packages.Table (The_Package).Next;
end loop; end loop;
pragma Assert pragma Assert
...@@ -762,22 +750,20 @@ package body Prj.Proc is ...@@ -762,22 +750,20 @@ package body Prj.Proc is
N_Variable_Reference N_Variable_Reference
then then
The_Variable_Id := The_Variable_Id :=
In_Tree.Packages.Table Shared.Packages.Table
(The_Package).Decl.Variables; (The_Package).Decl.Variables;
else else
The_Variable_Id := The_Variable_Id :=
In_Tree.Packages.Table Shared.Packages.Table
(The_Package).Decl.Attributes; (The_Package).Decl.Attributes;
end if; end if;
while The_Variable_Id /= No_Variable while The_Variable_Id /= No_Variable
and then and then Shared.Variable_Elements.Table
In_Tree.Variable_Elements.Table (The_Variable_Id).Name /= The_Name
(The_Variable_Id).Name /= The_Name
loop loop
The_Variable_Id := The_Variable_Id := Shared.Variable_Elements.Table
In_Tree.Variable_Elements.Table (The_Variable_Id).Next;
(The_Variable_Id).Next;
end loop; end loop;
end if; end if;
...@@ -795,12 +781,11 @@ package body Prj.Proc is ...@@ -795,12 +781,11 @@ package body Prj.Proc is
end if; end if;
while The_Variable_Id /= No_Variable while The_Variable_Id /= No_Variable
and then and then Shared.Variable_Elements.Table
In_Tree.Variable_Elements.Table
(The_Variable_Id).Name /= The_Name (The_Variable_Id).Name /= The_Name
loop loop
The_Variable_Id := The_Variable_Id :=
In_Tree.Variable_Elements.Table Shared.Variable_Elements.Table
(The_Variable_Id).Next; (The_Variable_Id).Next;
end loop; end loop;
...@@ -810,8 +795,7 @@ package body Prj.Proc is ...@@ -810,8 +795,7 @@ package body Prj.Proc is
"variable or attribute not found"); "variable or attribute not found");
The_Variable := The_Variable :=
In_Tree.Variable_Elements.Table Shared.Variable_Elements.Table (The_Variable_Id).Value;
(The_Variable_Id).Value;
else else
...@@ -824,22 +808,22 @@ package body Prj.Proc is ...@@ -824,22 +808,22 @@ package body Prj.Proc is
begin begin
if The_Package /= No_Package then if The_Package /= No_Package then
The_Array := The_Array := Shared.Packages.Table
In_Tree.Packages.Table (The_Package).Decl.Arrays; (The_Package).Decl.Arrays;
else else
The_Array := The_Project.Decl.Arrays; The_Array := The_Project.Decl.Arrays;
end if; end if;
while The_Array /= No_Array while The_Array /= No_Array
and then In_Tree.Arrays.Table and then Shared.Arrays.Table (The_Array).Name /=
(The_Array).Name /= The_Name The_Name
loop loop
The_Array := In_Tree.Arrays.Table (The_Array).Next; The_Array := Shared.Arrays.Table (The_Array).Next;
end loop; end loop;
if The_Array /= No_Array then if The_Array /= No_Array then
The_Element := The_Element :=
In_Tree.Arrays.Table (The_Array).Value; Shared.Arrays.Table (The_Array).Value;
Array_Index := Array_Index :=
Get_Attribute_Index Get_Attribute_Index
(From_Project_Node_Tree, (From_Project_Node_Tree,
...@@ -847,19 +831,19 @@ package body Prj.Proc is ...@@ -847,19 +831,19 @@ package body Prj.Proc is
Index); Index);
while The_Element /= No_Array_Element while The_Element /= No_Array_Element
and then In_Tree.Array_Elements.Table and then Shared.Array_Elements.Table
(The_Element).Index /= Array_Index (The_Element).Index /= Array_Index
loop loop
The_Element := The_Element :=
In_Tree.Array_Elements.Table Shared.Array_Elements.Table
(The_Element).Next; (The_Element).Next;
end loop; end loop;
end if; end if;
if The_Element /= No_Array_Element then if The_Element /= No_Array_Element then
The_Variable := The_Variable := Shared.Array_Elements.Table
In_Tree.Array_Elements.Table (The_Element).Value; (The_Element).Value;
else else
if Expression_Kind_Of if Expression_Kind_Of
...@@ -923,7 +907,7 @@ package body Prj.Proc is ...@@ -923,7 +907,7 @@ package body Prj.Proc is
when Single => when Single =>
String_Element_Table.Increment_Last String_Element_Table.Increment_Last
(In_Tree.String_Elements); (Shared.String_Elements);
if Last = Nil_String then if Last = Nil_String then
...@@ -932,20 +916,19 @@ package body Prj.Proc is ...@@ -932,20 +916,19 @@ package body Prj.Proc is
Result.Values := Result.Values :=
String_Element_Table.Last String_Element_Table.Last
(In_Tree.String_Elements); (Shared.String_Elements);
else else
In_Tree.String_Elements.Table Shared.String_Elements.Table (Last).Next :=
(Last).Next :=
String_Element_Table.Last String_Element_Table.Last
(In_Tree.String_Elements); (Shared.String_Elements);
end if; end if;
Last := Last :=
String_Element_Table.Last String_Element_Table.Last
(In_Tree.String_Elements); (Shared.String_Elements);
In_Tree.String_Elements.Table (Last) := Shared.String_Elements.Table (Last) :=
(Value => The_Variable.Value, (Value => The_Variable.Value,
Display_Value => No_Name, Display_Value => No_Name,
Location => Location_Of Location => Location_Of
...@@ -964,30 +947,29 @@ package body Prj.Proc is ...@@ -964,30 +947,29 @@ package body Prj.Proc is
begin begin
while The_List /= Nil_String loop while The_List /= Nil_String loop
String_Element_Table.Increment_Last String_Element_Table.Increment_Last
(In_Tree.String_Elements); (Shared.String_Elements);
if Last = Nil_String then if Last = Nil_String then
Result.Values := Result.Values :=
String_Element_Table.Last String_Element_Table.Last
(In_Tree. (Shared.String_Elements);
String_Elements);
else else
In_Tree. Shared.
String_Elements.Table (Last).Next := String_Elements.Table (Last).Next :=
String_Element_Table.Last String_Element_Table.Last
(In_Tree. (Shared.String_Elements);
String_Elements);
end if; end if;
Last := Last :=
String_Element_Table.Last String_Element_Table.Last
(In_Tree.String_Elements); (Shared.String_Elements);
In_Tree.String_Elements.Table (Last) := Shared.String_Elements.Table
(Last) :=
(Value => (Value =>
In_Tree.String_Elements.Table Shared.String_Elements.Table
(The_List).Value, (The_List).Value,
Display_Value => No_Name, Display_Value => No_Name,
Location => Location =>
...@@ -998,8 +980,7 @@ package body Prj.Proc is ...@@ -998,8 +980,7 @@ package body Prj.Proc is
Next => Nil_String, Next => Nil_String,
Index => 0); Index => 0);
The_List := The_List := Shared.String_Elements.Table
In_Tree. String_Elements.Table
(The_List).Next; (The_List).Next;
end loop; end loop;
end; end;
...@@ -1034,7 +1015,7 @@ package body Prj.Proc is ...@@ -1034,7 +1015,7 @@ package body Prj.Proc is
if Present (Default_Node) then if Present (Default_Node) then
Def_Var := Expression Def_Var := Expression
(Project => Project, (Project => Project,
In_Tree => In_Tree, Shared => Shared,
From_Project_Node => From_Project_Node, From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree, From_Project_Node_Tree => From_Project_Node_Tree,
Env => Env, Env => Env,
...@@ -1189,29 +1170,28 @@ package body Prj.Proc is ...@@ -1189,29 +1170,28 @@ package body Prj.Proc is
when List => when List =>
if not Ext_List or else Str_List /= null then if not Ext_List or else Str_List /= null then
String_Element_Table.Increment_Last String_Element_Table.Increment_Last
(In_Tree.String_Elements); (Shared.String_Elements);
if Last = Nil_String then if Last = Nil_String then
Result.Values := Result.Values :=
String_Element_Table.Last String_Element_Table.Last
(In_Tree.String_Elements); (Shared.String_Elements);
else else
In_Tree.String_Elements.Table (Last).Next := Shared.String_Elements.Table (Last).Next
String_Element_Table.Last := String_Element_Table.Last
(In_Tree.String_Elements); (Shared.String_Elements);
end if; end if;
Last := Last := String_Element_Table.Last
String_Element_Table.Last (Shared.String_Elements);
(In_Tree.String_Elements);
if Ext_List then if Ext_List then
for Ind in Str_List'Range loop for Ind in Str_List'Range loop
Name_Len := 0; Name_Len := 0;
Add_Str_To_Name_Buffer (Str_List (Ind).all); Add_Str_To_Name_Buffer (Str_List (Ind).all);
Value := Name_Find; Value := Name_Find;
In_Tree.String_Elements.Table (Last) := Shared.String_Elements.Table (Last) :=
(Value => Value, (Value => Value,
Display_Value => No_Name, Display_Value => No_Name,
Location => Location =>
...@@ -1224,19 +1204,17 @@ package body Prj.Proc is ...@@ -1224,19 +1204,17 @@ package body Prj.Proc is
if Ind /= Str_List'Last then if Ind /= Str_List'Last then
String_Element_Table.Increment_Last String_Element_Table.Increment_Last
(In_Tree.String_Elements); (Shared.String_Elements);
In_Tree.String_Elements.Table Shared.String_Elements.Table (Last).Next :=
(Last).Next :=
String_Element_Table.Last String_Element_Table.Last
(In_Tree.String_Elements); (Shared.String_Elements);
Last := Last := String_Element_Table.Last
String_Element_Table.Last (Shared.String_Elements);
(In_Tree.String_Elements);
end if; end if;
end loop; end loop;
else else
In_Tree.String_Elements.Table (Last) := Shared.String_Elements.Table (Last) :=
(Value => Value, (Value => Value,
Display_Value => No_Name, Display_Value => No_Name,
Location => Location =>
...@@ -1337,7 +1315,7 @@ package body Prj.Proc is ...@@ -1337,7 +1315,7 @@ package body Prj.Proc is
function Package_From function Package_From
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref; Shared : Shared_Project_Tree_Data_Access;
With_Name : Name_Id) return Package_Id With_Name : Name_Id) return Package_Id
is is
Result : Package_Id := Project.Decl.Packages; Result : Package_Id := Project.Decl.Packages;
...@@ -1346,9 +1324,9 @@ package body Prj.Proc is ...@@ -1346,9 +1324,9 @@ package body Prj.Proc is
-- Check the name of each existing package of Project -- Check the name of each existing package of Project
while Result /= No_Package while Result /= No_Package
and then In_Tree.Packages.Table (Result).Name /= With_Name and then Shared.Packages.Table (Result).Name /= With_Name
loop loop
Result := In_Tree.Packages.Table (Result).Next; Result := Shared.Packages.Table (Result).Next;
end loop; end loop;
if Result = No_Package then if Result = No_Package then
...@@ -1412,9 +1390,11 @@ package body Prj.Proc is ...@@ -1412,9 +1390,11 @@ package body Prj.Proc is
Env : Prj.Tree.Environment; Env : Prj.Tree.Environment;
Pkg : Package_Id; Pkg : Package_Id;
Item : Project_Node_Id; Item : Project_Node_Id;
Child_Env : in out Prj.Tree.Environment; Child_Env : in out Prj.Tree.Environment)
Can_Modify_Child_Env : Boolean)
is is
Shared : constant Shared_Project_Tree_Data_Access :=
In_Tree.Shared;
procedure Check_Or_Set_Typed_Variable procedure Check_Or_Set_Typed_Variable
(Value : in out Variable_Value; (Value : in out Variable_Value;
Declaration : Project_Node_Id); Declaration : Project_Node_Id);
...@@ -1532,11 +1512,11 @@ package body Prj.Proc is ...@@ -1532,11 +1512,11 @@ package body Prj.Proc is
-- Create the new package -- Create the new package
Package_Table.Increment_Last (In_Tree.Packages); Package_Table.Increment_Last (Shared.Packages);
declare declare
New_Pkg : constant Package_Id := New_Pkg : constant Package_Id :=
Package_Table.Last (In_Tree.Packages); Package_Table.Last (Shared.Packages);
The_New_Package : Package_Element; The_New_Package : Package_Element;
Project_Of_Renamed_Package : constant Project_Node_Id := Project_Of_Renamed_Package : constant Project_Node_Id :=
...@@ -1552,15 +1532,15 @@ package body Prj.Proc is ...@@ -1552,15 +1532,15 @@ package body Prj.Proc is
if Pkg /= No_Package then if Pkg /= No_Package then
The_New_Package.Next := The_New_Package.Next :=
In_Tree.Packages.Table (Pkg).Decl.Packages; Shared.Packages.Table (Pkg).Decl.Packages;
In_Tree.Packages.Table (Pkg).Decl.Packages := New_Pkg; Shared.Packages.Table (Pkg).Decl.Packages := New_Pkg;
else else
The_New_Package.Next := Project.Decl.Packages; The_New_Package.Next := Project.Decl.Packages;
Project.Decl.Packages := New_Pkg; Project.Decl.Packages := New_Pkg;
end if; end if;
In_Tree.Packages.Table (New_Pkg) := The_New_Package; Shared.Packages.Table (New_Pkg) := The_New_Package;
if Present (Project_Of_Renamed_Package) then if Present (Project_Of_Renamed_Package) then
...@@ -1576,7 +1556,7 @@ package body Prj.Proc is ...@@ -1576,7 +1556,7 @@ package body Prj.Proc is
Renamed_Package : constant Package_Id := Renamed_Package : constant Package_Id :=
Package_From Package_From
(Renamed_Project, In_Tree, (Renamed_Project, Shared,
Name_Of (Current_Item, Node_Tree)); Name_Of (Current_Item, Node_Tree));
begin begin
...@@ -1586,11 +1566,11 @@ package body Prj.Proc is ...@@ -1586,11 +1566,11 @@ package body Prj.Proc is
-- declaration. -- declaration.
Copy_Package_Declarations Copy_Package_Declarations
(From => In_Tree.Packages.Table (Renamed_Package).Decl, (From => Shared.Packages.Table (Renamed_Package).Decl,
To => In_Tree.Packages.Table (New_Pkg).Decl, To => Shared.Packages.Table (New_Pkg).Decl,
New_Loc => Location_Of (Current_Item, Node_Tree), New_Loc => Location_Of (Current_Item, Node_Tree),
Restricted => False, Restricted => False,
In_Tree => In_Tree); Shared => Shared);
end; end;
else else
...@@ -1600,8 +1580,8 @@ package body Prj.Proc is ...@@ -1600,8 +1580,8 @@ package body Prj.Proc is
(Project, (Project,
Project.Name, Project.Name,
Name_Id (Project.Directory.Name), Name_Id (Project.Directory.Name),
In_Tree, Shared,
In_Tree.Packages.Table (New_Pkg).Decl, Shared.Packages.Table (New_Pkg).Decl,
First_Attribute_Of First_Attribute_Of
(Package_Id_Of (Current_Item, Node_Tree)), (Package_Id_Of (Current_Item, Node_Tree)),
Project_Level => False); Project_Level => False);
...@@ -1619,8 +1599,7 @@ package body Prj.Proc is ...@@ -1619,8 +1599,7 @@ package body Prj.Proc is
Pkg => New_Pkg, Pkg => New_Pkg,
Item => Item =>
First_Declarative_Item_Of (Current_Item, Node_Tree), First_Declarative_Item_Of (Current_Item, Node_Tree),
Child_Env => Child_Env, Child_Env => Child_Env);
Can_Modify_Child_Env => Can_Modify_Child_Env);
end; end;
end if; end if;
end Process_Package_Declaration; end Process_Package_Declaration;
...@@ -1683,35 +1662,35 @@ package body Prj.Proc is ...@@ -1683,35 +1662,35 @@ package body Prj.Proc is
-- declared. -- declared.
if Pkg /= No_Package then if Pkg /= No_Package then
New_Array := In_Tree.Packages.Table (Pkg).Decl.Arrays; New_Array := Shared.Packages.Table (Pkg).Decl.Arrays;
else else
New_Array := Project.Decl.Arrays; New_Array := Project.Decl.Arrays;
end if; end if;
while New_Array /= No_Array while New_Array /= No_Array
and then In_Tree.Arrays.Table (New_Array).Name /= Current_Item_Name and then Shared.Arrays.Table (New_Array).Name /= Current_Item_Name
loop loop
New_Array := In_Tree.Arrays.Table (New_Array).Next; New_Array := Shared.Arrays.Table (New_Array).Next;
end loop; end loop;
-- If the attribute has never been declared add new entry in the -- If the attribute has never been declared add new entry in the
-- arrays of the project/package and link it. -- arrays of the project/package and link it.
if New_Array = No_Array then if New_Array = No_Array then
Array_Table.Increment_Last (In_Tree.Arrays); Array_Table.Increment_Last (Shared.Arrays);
New_Array := Array_Table.Last (In_Tree.Arrays); New_Array := Array_Table.Last (Shared.Arrays);
if Pkg /= No_Package then if Pkg /= No_Package then
In_Tree.Arrays.Table (New_Array) := Shared.Arrays.Table (New_Array) :=
(Name => Current_Item_Name, (Name => Current_Item_Name,
Location => Current_Location, Location => Current_Location,
Value => No_Array_Element, Value => No_Array_Element,
Next => In_Tree.Packages.Table (Pkg).Decl.Arrays); Next => Shared.Packages.Table (Pkg).Decl.Arrays);
In_Tree.Packages.Table (Pkg).Decl.Arrays := New_Array; Shared.Packages.Table (Pkg).Decl.Arrays := New_Array;
else else
In_Tree.Arrays.Table (New_Array) := Shared.Arrays.Table (New_Array) :=
(Name => Current_Item_Name, (Name => Current_Item_Name,
Location => Current_Location, Location => Current_Location,
Value => No_Array_Element, Value => No_Array_Element,
...@@ -1753,23 +1732,23 @@ package body Prj.Proc is ...@@ -1753,23 +1732,23 @@ package body Prj.Proc is
pragma Assert (Orig_Package /= No_Package, pragma Assert (Orig_Package /= No_Package,
"original package not found"); "original package not found");
while In_Tree.Packages.Table while Shared.Packages.Table
(Orig_Package).Name /= Orig_Package_Name (Orig_Package).Name /= Orig_Package_Name
loop loop
Orig_Package := In_Tree.Packages.Table (Orig_Package).Next; Orig_Package := Shared.Packages.Table (Orig_Package).Next;
pragma Assert (Orig_Package /= No_Package, pragma Assert (Orig_Package /= No_Package,
"original package not found"); "original package not found");
end loop; end loop;
Orig_Array := In_Tree.Packages.Table (Orig_Package).Decl.Arrays; Orig_Array := Shared.Packages.Table (Orig_Package).Decl.Arrays;
end if; end if;
-- Now look for the array -- Now look for the array
while Orig_Array /= No_Array while Orig_Array /= No_Array
and then In_Tree.Arrays.Table (Orig_Array).Name /= Current_Item_Name and then Shared.Arrays.Table (Orig_Array).Name /= Current_Item_Name
loop loop
Orig_Array := In_Tree.Arrays.Table (Orig_Array).Next; Orig_Array := Shared.Arrays.Table (Orig_Array).Next;
end loop; end loop;
if Orig_Array = No_Array then if Orig_Array = No_Array then
...@@ -1780,7 +1759,7 @@ package body Prj.Proc is ...@@ -1780,7 +1759,7 @@ package body Prj.Proc is
Project); Project);
else else
Orig_Element := In_Tree.Arrays.Table (Orig_Array).Value; Orig_Element := Shared.Arrays.Table (Orig_Array).Value;
-- Copy each array element -- Copy each array element
...@@ -1793,22 +1772,22 @@ package body Prj.Proc is ...@@ -1793,22 +1772,22 @@ package body Prj.Proc is
-- And there is no array element declared yet, create a new -- And there is no array element declared yet, create a new
-- first array element. -- first array element.
if In_Tree.Arrays.Table (New_Array).Value = if Shared.Arrays.Table (New_Array).Value =
No_Array_Element No_Array_Element
then then
Array_Element_Table.Increment_Last Array_Element_Table.Increment_Last
(In_Tree.Array_Elements); (Shared.Array_Elements);
New_Element := Array_Element_Table.Last New_Element := Array_Element_Table.Last
(In_Tree.Array_Elements); (Shared.Array_Elements);
In_Tree.Arrays.Table (New_Array).Value := New_Element; Shared.Arrays.Table (New_Array).Value := New_Element;
Next_Element := No_Array_Element; Next_Element := No_Array_Element;
-- Otherwise, the new element is the first -- Otherwise, the new element is the first
else else
New_Element := In_Tree.Arrays. Table (New_Array).Value; New_Element := Shared.Arrays.Table (New_Array).Value;
Next_Element := Next_Element :=
In_Tree.Array_Elements.Table (New_Element).Next; Shared.Array_Elements.Table (New_Element).Next;
end if; end if;
-- Otherwise, reuse an existing element, or create -- Otherwise, reuse an existing element, or create
...@@ -1816,33 +1795,33 @@ package body Prj.Proc is ...@@ -1816,33 +1795,33 @@ package body Prj.Proc is
else else
Next_Element := Next_Element :=
In_Tree.Array_Elements.Table (Prev_Element).Next; Shared.Array_Elements.Table (Prev_Element).Next;
if Next_Element = No_Array_Element then if Next_Element = No_Array_Element then
Array_Element_Table.Increment_Last Array_Element_Table.Increment_Last
(In_Tree.Array_Elements); (Shared.Array_Elements);
New_Element := New_Element := Array_Element_Table.Last
Array_Element_Table.Last (In_Tree.Array_Elements); (Shared.Array_Elements);
In_Tree.Array_Elements.Table (Prev_Element).Next := Shared.Array_Elements.Table (Prev_Element).Next :=
New_Element; New_Element;
else else
New_Element := Next_Element; New_Element := Next_Element;
Next_Element := Next_Element :=
In_Tree.Array_Elements.Table (New_Element).Next; Shared.Array_Elements.Table (New_Element).Next;
end if; end if;
end if; end if;
-- Copy the value of the element -- Copy the value of the element
In_Tree.Array_Elements.Table (New_Element) := Shared.Array_Elements.Table (New_Element) :=
In_Tree.Array_Elements.Table (Orig_Element); Shared.Array_Elements.Table (Orig_Element);
In_Tree.Array_Elements.Table (New_Element).Value.Project := Shared.Array_Elements.Table (New_Element).Value.Project
Project; := Project;
-- Adjust the Next link -- Adjust the Next link
In_Tree.Array_Elements.Table (New_Element).Next := Next_Element; Shared.Array_Elements.Table (New_Element).Next := Next_Element;
-- Adjust the previous id for the next element -- Adjust the previous id for the next element
...@@ -1850,15 +1829,13 @@ package body Prj.Proc is ...@@ -1850,15 +1829,13 @@ package body Prj.Proc is
-- Go to the next element in the original array -- Go to the next element in the original array
Orig_Element := Orig_Element := Shared.Array_Elements.Table (Orig_Element).Next;
In_Tree.Array_Elements.Table (Orig_Element).Next;
end loop; end loop;
-- Make sure that the array ends here, in case there previously a -- Make sure that the array ends here, in case there previously a
-- greater number of elements. -- greater number of elements.
In_Tree.Array_Elements.Table (New_Element).Next := Shared.Array_Elements.Table (New_Element).Next := No_Array_Element;
No_Array_Element;
end if; end if;
end Process_Associative_Array; end Process_Associative_Array;
...@@ -1891,15 +1868,15 @@ package body Prj.Proc is ...@@ -1891,15 +1868,15 @@ package body Prj.Proc is
-- Look for the array in the appropriate list -- Look for the array in the appropriate list
if Pkg /= No_Package then if Pkg /= No_Package then
The_Array := In_Tree.Packages.Table (Pkg).Decl.Arrays; The_Array := Shared.Packages.Table (Pkg).Decl.Arrays;
else else
The_Array := Project.Decl.Arrays; The_Array := Project.Decl.Arrays;
end if; end if;
while The_Array /= No_Array while The_Array /= No_Array
and then In_Tree.Arrays.Table (The_Array).Name /= Name and then Shared.Arrays.Table (The_Array).Name /= Name
loop loop
The_Array := In_Tree.Arrays.Table (The_Array).Next; The_Array := Shared.Arrays.Table (The_Array).Next;
end loop; end loop;
-- If the array cannot be found, create a new entry in the list. -- If the array cannot be found, create a new entry in the list.
...@@ -1907,20 +1884,20 @@ package body Prj.Proc is ...@@ -1907,20 +1884,20 @@ package body Prj.Proc is
-- element will be created automatically later -- element will be created automatically later
if The_Array = No_Array then if The_Array = No_Array then
Array_Table.Increment_Last (In_Tree.Arrays); Array_Table.Increment_Last (Shared.Arrays);
The_Array := Array_Table.Last (In_Tree.Arrays); The_Array := Array_Table.Last (Shared.Arrays);
if Pkg /= No_Package then if Pkg /= No_Package then
In_Tree.Arrays.Table (The_Array) := Shared.Arrays.Table (The_Array) :=
(Name => Name, (Name => Name,
Location => Current_Location, Location => Current_Location,
Value => No_Array_Element, Value => No_Array_Element,
Next => In_Tree.Packages.Table (Pkg).Decl.Arrays); Next => Shared.Packages.Table (Pkg).Decl.Arrays);
In_Tree.Packages.Table (Pkg).Decl.Arrays := The_Array; Shared.Packages.Table (Pkg).Decl.Arrays := The_Array;
else else
In_Tree.Arrays.Table (The_Array) := Shared.Arrays.Table (The_Array) :=
(Name => Name, (Name => Name,
Location => Current_Location, Location => Current_Location,
Value => No_Array_Element, Value => No_Array_Element,
...@@ -1930,7 +1907,7 @@ package body Prj.Proc is ...@@ -1930,7 +1907,7 @@ package body Prj.Proc is
end if; end if;
else else
Elem := In_Tree.Arrays.Table (The_Array).Value; Elem := Shared.Arrays.Table (The_Array).Value;
end if; end if;
-- Look in the list, if any, to find an element with the same index -- Look in the list, if any, to find an element with the same index
...@@ -1938,11 +1915,11 @@ package body Prj.Proc is ...@@ -1938,11 +1915,11 @@ package body Prj.Proc is
while Elem /= No_Array_Element while Elem /= No_Array_Element
and then and then
(In_Tree.Array_Elements.Table (Elem).Index /= Index_Name (Shared.Array_Elements.Table (Elem).Index /= Index_Name
or else or else
In_Tree.Array_Elements.Table (Elem).Src_Index /= Source_Index) Shared.Array_Elements.Table (Elem).Src_Index /= Source_Index)
loop loop
Elem := In_Tree.Array_Elements.Table (Elem).Next; Elem := Shared.Array_Elements.Table (Elem).Next;
end loop; end loop;
-- If no such element were found, create a new one -- If no such element were found, create a new one
...@@ -1950,29 +1927,29 @@ package body Prj.Proc is ...@@ -1950,29 +1927,29 @@ package body Prj.Proc is
-- proper value. -- proper value.
if Elem = No_Array_Element then if Elem = No_Array_Element then
Array_Element_Table.Increment_Last (In_Tree.Array_Elements); Array_Element_Table.Increment_Last (Shared.Array_Elements);
Elem := Array_Element_Table.Last (In_Tree.Array_Elements); Elem := Array_Element_Table.Last (Shared.Array_Elements);
In_Tree.Array_Elements.Table Shared.Array_Elements.Table
(Elem) := (Elem) :=
(Index => Index_Name, (Index => Index_Name,
Src_Index => Source_Index, Src_Index => Source_Index,
Index_Case_Sensitive => Index_Case_Sensitive =>
not Case_Insensitive (Current, Node_Tree), not Case_Insensitive (Current, Node_Tree),
Value => New_Value, Value => New_Value,
Next => In_Tree.Arrays.Table (The_Array).Value); Next => Shared.Arrays.Table (The_Array).Value);
In_Tree.Arrays.Table (The_Array).Value := Elem; Shared.Arrays.Table (The_Array).Value := Elem;
else else
-- An element with the same index already exists, just replace its -- An element with the same index already exists, just replace its
-- value with the new one. -- value with the new one.
In_Tree.Array_Elements.Table (Elem).Value := New_Value; Shared.Array_Elements.Table (Elem).Value := New_Value;
end if; end if;
if Name = Snames.Name_External then if Name = Snames.Name_External then
if Can_Modify_Child_Env then if In_Tree.Is_Root_Tree then
Add (Child_Env.External, Add (Child_Env.External,
External_Name => Get_Name_String (Index_Name), External_Name => Get_Name_String (Index_Name),
Value => Get_Name_String (New_Value.Value), Value => Get_Name_String (New_Value.Value),
...@@ -2015,14 +1992,14 @@ package body Prj.Proc is ...@@ -2015,14 +1992,14 @@ package body Prj.Proc is
if Is_Attribute then if Is_Attribute then
if Pkg /= No_Package then if Pkg /= No_Package then
Var := In_Tree.Packages.Table (Pkg).Decl.Attributes; Var := Shared.Packages.Table (Pkg).Decl.Attributes;
else else
Var := Project.Decl.Attributes; Var := Project.Decl.Attributes;
end if; end if;
else else
if Pkg /= No_Package then if Pkg /= No_Package then
Var := In_Tree.Packages.Table (Pkg).Decl.Variables; Var := Shared.Packages.Table (Pkg).Decl.Variables;
else else
Var := Project.Decl.Variables; Var := Project.Decl.Variables;
end if; end if;
...@@ -2031,9 +2008,9 @@ package body Prj.Proc is ...@@ -2031,9 +2008,9 @@ package body Prj.Proc is
-- Loop through the list, to find if it has already been declared. -- Loop through the list, to find if it has already been declared.
while Var /= No_Variable while Var /= No_Variable
and then In_Tree.Variable_Elements.Table (Var).Name /= Name and then Shared.Variable_Elements.Table (Var).Name /= Name
loop loop
Var := In_Tree.Variable_Elements.Table (Var).Next; Var := Shared.Variable_Elements.Table (Var).Next;
end loop; end loop;
-- If it has not been declared, create a new entry in the list -- If it has not been declared, create a new entry in the list
...@@ -2047,20 +2024,20 @@ package body Prj.Proc is ...@@ -2047,20 +2024,20 @@ package body Prj.Proc is
(not Is_Attribute, (not Is_Attribute,
"illegal attribute declaration for " & Get_Name_String (Name)); "illegal attribute declaration for " & Get_Name_String (Name));
Variable_Element_Table.Increment_Last (In_Tree.Variable_Elements); Variable_Element_Table.Increment_Last (Shared.Variable_Elements);
Var := Variable_Element_Table.Last (In_Tree.Variable_Elements); Var := Variable_Element_Table.Last (Shared.Variable_Elements);
-- Put the new variable in the appropriate list -- Put the new variable in the appropriate list
if Pkg /= No_Package then if Pkg /= No_Package then
In_Tree.Variable_Elements.Table (Var) := Shared.Variable_Elements.Table (Var) :=
(Next => In_Tree.Packages.Table (Pkg).Decl.Variables, (Next => Shared.Packages.Table (Pkg).Decl.Variables,
Name => Name, Name => Name,
Value => New_Value); Value => New_Value);
In_Tree.Packages.Table (Pkg).Decl.Variables := Var; Shared.Packages.Table (Pkg).Decl.Variables := Var;
else else
In_Tree.Variable_Elements.Table (Var) := Shared.Variable_Elements.Table (Var) :=
(Next => Project.Decl.Variables, (Next => Project.Decl.Variables,
Name => Name, Name => Name,
Value => New_Value); Value => New_Value);
...@@ -2071,7 +2048,7 @@ package body Prj.Proc is ...@@ -2071,7 +2048,7 @@ package body Prj.Proc is
-- change the value. -- change the value.
else else
In_Tree.Variable_Elements.Table (Var).Value := New_Value; Shared.Variable_Elements.Table (Var).Value := New_Value;
end if; end if;
end Process_Expression_Variable_Decl; end Process_Expression_Variable_Decl;
...@@ -2083,7 +2060,7 @@ package body Prj.Proc is ...@@ -2083,7 +2060,7 @@ package body Prj.Proc is
New_Value : Variable_Value := New_Value : Variable_Value :=
Expression Expression
(Project => Project, (Project => Project,
In_Tree => In_Tree, Shared => Shared,
From_Project_Node => From_Project_Node, From_Project_Node => From_Project_Node,
From_Project_Node_Tree => Node_Tree, From_Project_Node_Tree => Node_Tree,
Env => Env, Env => Env,
...@@ -2173,7 +2150,7 @@ package body Prj.Proc is ...@@ -2173,7 +2150,7 @@ package body Prj.Proc is
Name := Name :=
Name_Of Name_Of
(Package_Node_Of (Variable_Node, Node_Tree), Node_Tree); (Package_Node_Of (Variable_Node, Node_Tree), Node_Tree);
The_Package := Package_From (The_Project, In_Tree, Name); The_Package := Package_From (The_Project, Shared, Name);
end if; end if;
Name := Name_Of (Variable_Node, Node_Tree); Name := Name_Of (Variable_Node, Node_Tree);
...@@ -2183,11 +2160,11 @@ package body Prj.Proc is ...@@ -2183,11 +2160,11 @@ package body Prj.Proc is
if The_Package /= No_Package then if The_Package /= No_Package then
Name := Name_Of (Variable_Node, Node_Tree); Name := Name_Of (Variable_Node, Node_Tree);
Var_Id := In_Tree.Packages.Table (The_Package).Decl.Variables; Var_Id := Shared.Packages.Table (The_Package).Decl.Variables;
while Var_Id /= No_Variable while Var_Id /= No_Variable
and then In_Tree.Variable_Elements.Table (Var_Id).Name /= Name and then Shared.Variable_Elements.Table (Var_Id).Name /= Name
loop loop
Var_Id := In_Tree.Variable_Elements.Table (Var_Id).Next; Var_Id := Shared.Variable_Elements.Table (Var_Id).Next;
end loop; end loop;
end if; end if;
...@@ -2199,9 +2176,9 @@ package body Prj.Proc is ...@@ -2199,9 +2176,9 @@ package body Prj.Proc is
then then
Var_Id := The_Project.Decl.Variables; Var_Id := The_Project.Decl.Variables;
while Var_Id /= No_Variable while Var_Id /= No_Variable
and then In_Tree.Variable_Elements.Table (Var_Id).Name /= Name and then Shared.Variable_Elements.Table (Var_Id).Name /= Name
loop loop
Var_Id := In_Tree.Variable_Elements.Table (Var_Id).Next; Var_Id := Shared.Variable_Elements.Table (Var_Id).Next;
end loop; end loop;
end if; end if;
...@@ -2217,7 +2194,7 @@ package body Prj.Proc is ...@@ -2217,7 +2194,7 @@ package body Prj.Proc is
-- Get the case variable -- Get the case variable
The_Variable := In_Tree.Variable_Elements. Table (Var_Id).Value; The_Variable := Shared.Variable_Elements. Table (Var_Id).Value;
if The_Variable.Kind /= Single then if The_Variable.Kind /= Single then
...@@ -2270,15 +2247,14 @@ package body Prj.Proc is ...@@ -2270,15 +2247,14 @@ package body Prj.Proc is
if Present (Decl_Item) then if Present (Decl_Item) then
Process_Declarative_Items Process_Declarative_Items
(Project => Project, (Project => Project,
In_Tree => In_Tree, In_Tree => In_Tree,
From_Project_Node => From_Project_Node, From_Project_Node => From_Project_Node,
Node_Tree => Node_Tree, Node_Tree => Node_Tree,
Env => Env, Env => Env,
Pkg => Pkg, Pkg => Pkg,
Item => Decl_Item, Item => Decl_Item,
Child_Env => Child_Env, Child_Env => Child_Env);
Can_Modify_Child_Env => Can_Modify_Child_Env);
end if; end if;
end Process_Case_Construction; end Process_Case_Construction;
...@@ -2333,8 +2309,6 @@ package body Prj.Proc is ...@@ -2333,8 +2309,6 @@ package body Prj.Proc is
Env : in out Prj.Tree.Environment; Env : in out Prj.Tree.Environment;
Reset_Tree : Boolean := True) Reset_Tree : Boolean := True)
is is
Child_Env : Prj.Tree.Environment;
begin begin
if Reset_Tree then if Reset_Tree then
...@@ -2350,19 +2324,13 @@ package body Prj.Proc is ...@@ -2350,19 +2324,13 @@ package body Prj.Proc is
Debug_Increase_Indent ("Process tree, phase 1"); Debug_Increase_Indent ("Process tree, phase 1");
Initialize_And_Copy (Child_Env, Copy_From => Env);
Recursive_Process Recursive_Process
(Project => Project, (Project => Project,
In_Tree => In_Tree, In_Tree => In_Tree,
From_Project_Node => From_Project_Node, From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree, From_Project_Node_Tree => From_Project_Node_Tree,
Env => Env, Env => Env,
Extended_By => No_Project, Extended_By => No_Project);
Child_Env => Child_Env,
Is_Root_Project => True);
Free (Child_Env);
Success := Success :=
Total_Errors_Detected = 0 Total_Errors_Detected = 0
...@@ -2397,7 +2365,7 @@ package body Prj.Proc is ...@@ -2397,7 +2365,7 @@ package body Prj.Proc is
begin begin
Success := True; Success := True;
Debug_Increase_Indent ("Process tree, phase 2"); Debug_Increase_Indent ("Process tree, phase 2", Project.Name);
if Project /= No_Project then if Project /= No_Project then
Check (In_Tree, Project, From_Project_Node_Tree, Env.Flags); Check (In_Tree, Project, From_Project_Node_Tree, Env.Flags);
...@@ -2498,10 +2466,15 @@ package body Prj.Proc is ...@@ -2498,10 +2466,15 @@ package body 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;
Extended_By : Project_Id; Extended_By : Project_Id)
Child_Env : in out Prj.Tree.Environment;
Is_Root_Project : Boolean)
is is
Shared : constant Shared_Project_Tree_Data_Access :=
In_Tree.Shared;
Child_Env : Prj.Tree.Environment;
-- Only used for the root aggregate project (if any). This is left
-- uninitialized otherwise.
procedure Process_Imported_Projects procedure Process_Imported_Projects
(Imported : in out Project_List; (Imported : in out Project_List;
Limited_With : Boolean); Limited_With : Boolean);
...@@ -2553,9 +2526,7 @@ package body Prj.Proc is ...@@ -2553,9 +2526,7 @@ package body Prj.Proc is
(With_Clause, From_Project_Node_Tree), (With_Clause, From_Project_Node_Tree),
From_Project_Node_Tree => From_Project_Node_Tree, From_Project_Node_Tree => From_Project_Node_Tree,
Env => Env, Env => Env,
Extended_By => No_Project, Extended_By => No_Project);
Child_Env => Child_Env,
Is_Root_Project => False);
-- Imported is the id of the last imported project. If -- Imported is the id of the last imported project. If
-- it is nil, then this imported project is our first. -- it is nil, then this imported project is our first.
...@@ -2585,7 +2556,7 @@ package body Prj.Proc is ...@@ -2585,7 +2556,7 @@ package body Prj.Proc is
procedure Process_Aggregated_Projects is procedure Process_Aggregated_Projects is
List : Aggregated_Project_List; List : Aggregated_Project_List;
Loaded_Tree : Prj.Tree.Project_Node_Id; Loaded_Project : Prj.Tree.Project_Node_Id;
Success : Boolean := True; Success : Boolean := True;
begin begin
if Project.Qualifier /= Aggregate then if Project.Qualifier /= Aggregate then
...@@ -2604,25 +2575,46 @@ package body Prj.Proc is ...@@ -2604,25 +2575,46 @@ package body Prj.Proc is
while Success and then List /= null loop while Success and then List /= null loop
Prj.Part.Parse Prj.Part.Parse
(In_Tree => From_Project_Node_Tree, (In_Tree => From_Project_Node_Tree,
Project => Loaded_Tree, Project => Loaded_Project,
Project_File_Name => Get_Name_String (List.Path), Project_File_Name => Get_Name_String (List.Path),
Errout_Handling => Prj.Part.Never_Finalize, Errout_Handling => Prj.Part.Never_Finalize,
Current_Directory => Get_Name_String (Project.Directory.Name), Current_Directory => Get_Name_String (Project.Directory.Name),
Is_Config_File => False, Is_Config_File => False,
Env => Child_Env); Env => Child_Env);
Success := not Prj.Tree.No (Loaded_Tree); Success := not Prj.Tree.No (Loaded_Project);
if Success then if Success then
Recursive_Process List.Tree := new Project_Tree_Data (Is_Root_Tree => False);
(In_Tree => In_Tree, Prj.Initialize (List.Tree);
Project => List.Project, List.Tree.Shared := In_Tree.Shared;
From_Project_Node => Loaded_Tree,
From_Project_Node_Tree => From_Project_Node_Tree, -- We can only do the phase 1 of the processing, since we do
Env => Child_Env, -- not have access to the configuration file yet (this is
Extended_By => No_Project, -- called when doing phase 1 of the processing for the root
Child_Env => Child_Env, -- aggregate project).
Is_Root_Project => False);
if In_Tree.Is_Root_Tree then
Process_Project_Tree_Phase_1
(In_Tree => List.Tree,
Project => List.Project,
Success => Success,
From_Project_Node => Loaded_Project,
From_Project_Node_Tree => From_Project_Node_Tree,
Env => Child_Env,
Reset_Tree => False);
else
-- use the same environment as the rest of the aggregated
-- projects, ie the one that was setup by the root aggregate
Process_Project_Tree_Phase_1
(In_Tree => List.Tree,
Project => List.Project,
Success => Success,
From_Project_Node => Loaded_Project,
From_Project_Node_Tree => From_Project_Node_Tree,
Env => Env,
Reset_Tree => False);
end if;
else else
Debug_Output ("Failed to parse", Name_Id (List.Path)); Debug_Output ("Failed to parse", Name_Id (List.Path));
end if; end if;
...@@ -2650,21 +2642,20 @@ package body Prj.Proc is ...@@ -2650,21 +2642,20 @@ package body Prj.Proc is
begin begin
Extended_Pkg := Project.Extends.Decl.Packages; Extended_Pkg := Project.Extends.Decl.Packages;
while Extended_Pkg /= No_Package loop while Extended_Pkg /= No_Package loop
Element := In_Tree.Packages.Table (Extended_Pkg); Element := Shared.Packages.Table (Extended_Pkg);
Current_Pkg := First; Current_Pkg := First;
while Current_Pkg /= No_Package while Current_Pkg /= No_Package
and then In_Tree.Packages.Table (Current_Pkg).Name /= and then Shared.Packages.Table (Current_Pkg).Name /=
Element.Name Element.Name
loop loop
Current_Pkg := Current_Pkg := Shared.Packages.Table (Current_Pkg).Next;
In_Tree.Packages.Table (Current_Pkg).Next;
end loop; end loop;
if Current_Pkg = No_Package then if Current_Pkg = No_Package then
Package_Table.Increment_Last (In_Tree.Packages); Package_Table.Increment_Last (Shared.Packages);
Current_Pkg := Package_Table.Last (In_Tree.Packages); Current_Pkg := Package_Table.Last (Shared.Packages);
In_Tree.Packages.Table (Current_Pkg) := Shared.Packages.Table (Current_Pkg) :=
(Name => Element.Name, (Name => Element.Name,
Decl => No_Declarations, Decl => No_Declarations,
Parent => No_Package, Parent => No_Package,
...@@ -2672,10 +2663,10 @@ package body Prj.Proc is ...@@ -2672,10 +2663,10 @@ package body Prj.Proc is
Project.Decl.Packages := Current_Pkg; Project.Decl.Packages := Current_Pkg;
Copy_Package_Declarations Copy_Package_Declarations
(From => Element.Decl, (From => Element.Decl,
To => In_Tree.Packages.Table (Current_Pkg).Decl, To => Shared.Packages.Table (Current_Pkg).Decl,
New_Loc => No_Location, New_Loc => No_Location,
Restricted => True, Restricted => True,
In_Tree => In_Tree); Shared => Shared);
end if; end if;
Extended_Pkg := Element.Next; Extended_Pkg := Element.Next;
...@@ -2685,7 +2676,7 @@ package body Prj.Proc is ...@@ -2685,7 +2676,7 @@ package body Prj.Proc is
Attribute1 := Project.Decl.Attributes; Attribute1 := Project.Decl.Attributes;
while Attribute1 /= No_Variable loop while Attribute1 /= No_Variable loop
Attr_Value1 := In_Tree.Variable_Elements. Table (Attribute1); Attr_Value1 := Shared.Variable_Elements. Table (Attribute1);
exit when Attr_Value1.Name = Snames.Name_Languages; exit when Attr_Value1.Name = Snames.Name_Languages;
Attribute1 := Attr_Value1.Next; Attribute1 := Attr_Value1.Next;
end loop; end loop;
...@@ -2698,7 +2689,7 @@ package body Prj.Proc is ...@@ -2698,7 +2689,7 @@ package body Prj.Proc is
Attribute2 := Project.Extends.Decl.Attributes; Attribute2 := Project.Extends.Decl.Attributes;
while Attribute2 /= No_Variable loop while Attribute2 /= No_Variable loop
Attr_Value2 := In_Tree.Variable_Elements.Table (Attribute2); Attr_Value2 := Shared.Variable_Elements.Table (Attribute2);
exit when Attr_Value2.Name = Snames.Name_Languages; exit when Attr_Value2.Name = Snames.Name_Languages;
Attribute2 := Attr_Value2.Next; Attribute2 := Attr_Value2.Next;
end loop; end loop;
...@@ -2711,17 +2702,16 @@ package body Prj.Proc is ...@@ -2711,17 +2702,16 @@ package body Prj.Proc is
if Attribute1 = No_Variable then if Attribute1 = No_Variable then
Variable_Element_Table.Increment_Last Variable_Element_Table.Increment_Last
(In_Tree.Variable_Elements); (Shared.Variable_Elements);
Attribute1 := Variable_Element_Table.Last Attribute1 := Variable_Element_Table.Last
(In_Tree.Variable_Elements); (Shared.Variable_Elements);
Attr_Value1.Next := Project.Decl.Attributes; Attr_Value1.Next := Project.Decl.Attributes;
Project.Decl.Attributes := Attribute1; Project.Decl.Attributes := Attribute1;
end if; end if;
Attr_Value1.Name := Snames.Name_Languages; Attr_Value1.Name := Snames.Name_Languages;
Attr_Value1.Value := Attr_Value2.Value; Attr_Value1.Value := Attr_Value2.Value;
In_Tree.Variable_Elements.Table Shared.Variable_Elements.Table (Attribute1) := Attr_Value1;
(Attribute1) := Attr_Value1;
end if; end if;
end if; end if;
end Process_Extended_Project; end Process_Extended_Project;
...@@ -2806,13 +2796,24 @@ package body Prj.Proc is ...@@ -2806,13 +2796,24 @@ package body Prj.Proc is
(Project, (Project,
Name, Name,
Name_Id (Project.Directory.Name), Name_Id (Project.Directory.Name),
In_Tree, In_Tree.Shared,
Project.Decl, Project.Decl,
Prj.Attr.Attribute_First, Prj.Attr.Attribute_First,
Project_Level => True); Project_Level => True);
Process_Imported_Projects (Imported, Limited_With => False); Process_Imported_Projects (Imported, Limited_With => False);
if Project.Qualifier = Aggregate
and then In_Tree.Is_Root_Tree
then
Initialize_And_Copy (Child_Env, Copy_From => Env);
else
-- No need to initialize Child_Env, since it will not be
-- used anyway by Process_Declarative_Items (only the root
-- aggregate can modify it, and it is never read anyway).
null;
end if;
Declaration_Node := Declaration_Node :=
Project_Declaration_Of Project_Declaration_Of
(From_Project_Node, From_Project_Node_Tree); (From_Project_Node, From_Project_Node_Tree);
...@@ -2824,9 +2825,7 @@ package body Prj.Proc is ...@@ -2824,9 +2825,7 @@ package body Prj.Proc is
(Declaration_Node, From_Project_Node_Tree), (Declaration_Node, From_Project_Node_Tree),
From_Project_Node_Tree => From_Project_Node_Tree, From_Project_Node_Tree => From_Project_Node_Tree,
Env => Env, Env => Env,
Extended_By => Project, Extended_By => Project);
Child_Env => Child_Env,
Is_Root_Project => False);
Process_Declarative_Items Process_Declarative_Items
(Project => Project, (Project => Project,
...@@ -2837,8 +2836,7 @@ package body Prj.Proc is ...@@ -2837,8 +2836,7 @@ package body Prj.Proc is
Pkg => No_Package, Pkg => No_Package,
Item => First_Declarative_Item_Of Item => First_Declarative_Item_Of
(Declaration_Node, From_Project_Node_Tree), (Declaration_Node, From_Project_Node_Tree),
Child_Env => Child_Env, Child_Env => Child_Env);
Can_Modify_Child_Env => Is_Root_Project);
if Project.Extends /= No_Project then if Project.Extends /= No_Project then
Process_Extended_Project; Process_Extended_Project;
...@@ -2849,6 +2847,12 @@ package body Prj.Proc is ...@@ -2849,6 +2847,12 @@ package body Prj.Proc is
if Err_Vars.Total_Errors_Detected = 0 then if Err_Vars.Total_Errors_Detected = 0 then
Process_Aggregated_Projects; Process_Aggregated_Projects;
end if; end if;
if Project.Qualifier = Aggregate
and then In_Tree.Is_Root_Tree
then
Free (Child_Env);
end if;
end; end;
end if; end if;
end Recursive_Process; end Recursive_Process;
......
gcc/ada/prj-proc.ads
...@@ -72,7 +72,7 @@ package Prj.Proc is ...@@ -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;
gcc/ada/prj-util.adb
...@@ -6,7 +6,7 @@ ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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;
......
gcc/ada/prj-util.ads
...@@ -6,7 +6,7 @@ ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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.
......
gcc/ada/prj.adb
...@@ -404,6 +404,7 @@ package body Prj is ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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;
......
gcc/ada/prj.ads
...@@ -1094,6 +1094,7 @@ package Prj is ...@@ -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 ...@@ -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.
type Project_Tree_Data (Is_Root_Tree : Boolean := True) is record
-- The root tree is the one loaded by the user from the command line.
-- Is_Root_Tree is only false for projects aggregated within a root
-- aggregate project.
Projects : Project_List;
-- List of projects in this tree
Replaced_Sources : Replaced_Source_HTable.Instance;
-- The list of sources that have been replaced by sources with
-- different file names.
Replaced_Source_Number : Natural := 0;
-- The number of entries in Replaced_Sources
Replaced_Sources : Replaced_Source_HTable.Instance; Units_HT : Units_Htable.Instance;
-- The list of sources that have been replaced by sources with -- Unit name to Unit_Index (and from there to Source_Id)
-- different file names.
Replaced_Source_Number : Natural := 0; Source_Files_HT : Source_Files_Htable.Instance;
-- The number of entries in Replaced_Sources -- Base source file names to Source_Id list.
Units_HT : Units_Htable.Instance; Source_Paths_HT : Source_Paths_Htable.Instance;
-- Unit name to Unit_Index (and from there to Source_Id) -- Full path to Source_Id
Source_Files_HT : Source_Files_Htable.Instance; Source_Info_File_Name : String_Access := null;
-- Base source file names to Source_Id list. -- The name of the source info file, if specified by the builder
Source_Paths_HT : Source_Paths_Htable.Instance; Source_Info_File_Exists : Boolean := False;
-- Full path to Source_Id -- True when a source info file has been successfully read
Source_Info_File_Name : String_Access := null; Private_Part : Private_Project_Tree_Data;
-- The name of the source info file, if specified by the builder
Source_Info_File_Exists : Boolean := False; Shared : Shared_Project_Tree_Data_Access;
-- True when a source info file has been successfully read -- The shared data for this tree and all aggregated trees.
Private_Part : Private_Project_Tree_Data; case Is_Root_Tree is
end record; 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 ...@@ -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 ...@@ -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;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment