summaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2011-08-03 10:19:32 +0000
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2011-08-03 10:19:32 +0000
commit039fcfa6316d4a70d271d974f9ded9c2001a97b8 (patch)
treeb0a3d19077a30eaebc12a8b662cc50d870dcdb04 /gcc/ada
parent3aa582cd74c2d892c68361298d2e6e83b9d1d595 (diff)
downloadgcc-039fcfa6316d4a70d271d974f9ded9c2001a97b8.tar.gz
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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@177261 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/ChangeLog16
-rw-r--r--gcc/ada/clean.adb6
-rw-r--r--gcc/ada/gnatcmd.adb59
-rw-r--r--gcc/ada/make.adb86
-rw-r--r--gcc/ada/makeutl.adb35
-rw-r--r--gcc/ada/makeutl.ads3
-rw-r--r--gcc/ada/mlib-prj.adb30
-rw-r--r--gcc/ada/prj-conf.adb163
-rw-r--r--gcc/ada/prj-conf.ads11
-rw-r--r--gcc/ada/prj-env.adb135
-rw-r--r--gcc/ada/prj-env.ads5
-rw-r--r--gcc/ada/prj-nmsc.adb369
-rw-r--r--gcc/ada/prj-proc.adb584
-rw-r--r--gcc/ada/prj-proc.ads2
-rw-r--r--gcc/ada/prj-util.adb95
-rw-r--r--gcc/ada/prj-util.ads20
-rw-r--r--gcc/ada/prj.adb110
-rw-r--r--gcc/ada/prj.ads87
18 files changed, 1009 insertions, 807 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 7cb3c194feb..5fa9661a903 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,19 @@
+2011-08-03 Emmanuel Briot <briot@adacore.com>
+
+ * gnatcmd.adb, prj-proc.adb, prj-proc.ads, make.adb, mlib-prj.adb,
+ prj.adb, prj.ads, makeutl.adb, makeutl.ads, clean.adb, prj-nmsc.adb,
+ prj-util.adb, prj-util.ads, prj-conf.adb, prj-conf.ads, prj-env.adb,
+ prj-env.ads (Shared_Project_Tree_Data): new type
+ An aggregate project and its aggregated trees need to share the common
+ data structures used for lists of strings, packages,... This makes the
+ code simpler since otherwise we have to pass the root tree (also used
+ for the configuration file data) in addition to the current project
+ tree. This also avoids ambiguities as to which tree should be used.
+ And finally this saves a bit of memory.
+ (For_Every_Project_Imported): new parameter Tree.
+ Since aggregated projects are using a different tree, we need to let
+ the caller know which tree to use to manipulate the returned project.
+
2011-08-03 Robert Dewar <dewar@adacore.com>
* prj-proc.adb, exp_util.ads, exp_ch9.adb, make.adb, prj-ext.adb,
diff --git a/gcc/ada/clean.adb b/gcc/ada/clean.adb
index 9bbf1159051..82f70816c9e 100644
--- a/gcc/ada/clean.adb
+++ b/gcc/ada/clean.adb
@@ -1170,7 +1170,7 @@ package body Clean is
Executable :=
Executable_Of
(Main_Project,
- Project_Tree,
+ Project_Tree.Shared,
Main_Source_File,
Current_File_Index);
@@ -1425,7 +1425,7 @@ package body Clean is
-- Add source directories and object directories to the search paths
Add_Source_Directories (Main_Project, Project_Tree);
- Add_Object_Directories (Main_Project);
+ Add_Object_Directories (Main_Project, Project_Tree);
end if;
Osint.Add_Default_Search_Dirs;
@@ -1440,7 +1440,7 @@ package body Clean is
Value : String_List_Id := Main_Project.Mains;
begin
while Value /= Prj.Nil_String loop
- Main := Project_Tree.String_Elements.Table (Value);
+ Main := Project_Tree.Shared.String_Elements.Table (Value);
Osint.Add_File
(File_Name => Get_Name_String (Main.Value),
Index => Main.Index);
diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb
index 99d6953c423..623b188ed81 100644
--- a/gcc/ada/gnatcmd.adb
+++ b/gcc/ada/gnatcmd.adb
@@ -255,6 +255,7 @@ procedure GNATCmd is
procedure Set_Library_For
(Project : Project_Id;
+ Tree : Project_Tree_Ref;
Libraries_Present : in out Boolean);
-- If Project is a library project, add the correct -L and -l switches to
-- the linker invocation.
@@ -445,7 +446,7 @@ procedure GNATCmd is
B_Start.all &
MLib.Fil.Ext_To
(Get_Name_String
- (Project_Tree.String_Elements.Table
+ (Project_Tree.Shared.String_Elements.Table
(Main).Value),
"ci"));
@@ -463,13 +464,13 @@ procedure GNATCmd is
"b__" &
MLib.Fil.Ext_To
(Get_Name_String
- (Project_Tree.String_Elements.Table
- (Main).Value),
+ (Project_Tree.Shared
+ .String_Elements.Table (Main).Value),
"ci"));
end if;
- Main :=
- Project_Tree.String_Elements.Table (Main).Next;
+ Main := Project_Tree.Shared.String_Elements.Table
+ (Main).Next;
end loop;
if Proj.Project.Library then
@@ -960,7 +961,7 @@ procedure GNATCmd is
-- Check if there are library project files
if MLib.Tgt.Support_For_Libraries /= None then
- Set_Libraries (Project, Libraries_Present);
+ Set_Libraries (Project, Project_Tree, Libraries_Present);
end if;
-- If there are, add the necessary additional switches
@@ -1236,8 +1237,10 @@ procedure GNATCmd is
procedure Set_Library_For
(Project : Project_Id;
+ Tree : Project_Tree_Ref;
Libraries_Present : in out Boolean)
is
+ pragma Unreferenced (Tree);
Path_Option : constant String_Access :=
MLib.Linker_Library_Path_Option;
@@ -1870,7 +1873,7 @@ begin
Prj.Util.Value_Of
(Name => Tool_Package_Name,
In_Packages => Project.Decl.Packages,
- In_Tree => Project_Tree);
+ Shared => Project_Tree.Shared);
Element : Package_Element;
@@ -1884,7 +1887,7 @@ begin
begin
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
-- Switches, that is not an associative array.
@@ -1894,7 +1897,7 @@ begin
Prj.Util.Value_Of
(Variable_Name => Snames.Name_Switches,
In_Variables => Element.Decl.Attributes,
- In_Tree => Project_Tree);
+ Shared => Project_Tree.Shared);
-- Packages Binder (for gnatbind), Cross_Reference (for
-- gnatxref), Linker (for gnatlink), Finder (for gnatfind),
@@ -1926,14 +1929,14 @@ begin
Prj.Util.Value_Of
(Name => Name_Switches,
In_Arrays => Element.Decl.Arrays,
- In_Tree => Project_Tree);
+ Shared => Project_Tree.Shared);
Name_Len := 0;
Add_Str_To_Name_Buffer (Main.all);
The_Switches := Prj.Util.Value_Of
(Index => Name_Find,
Src_Index => 0,
In_Array => Switches_Array,
- In_Tree => Project_Tree);
+ Shared => Project_Tree.Shared);
end if;
if The_Switches.Kind = Prj.Undefined then
@@ -1941,12 +1944,12 @@ begin
Prj.Util.Value_Of
(Name => Name_Default_Switches,
In_Arrays => Element.Decl.Arrays,
- In_Tree => Project_Tree);
+ Shared => Project_Tree.Shared);
The_Switches := Prj.Util.Value_Of
(Index => Name_Ada,
Src_Index => 0,
In_Array => Switches_Array,
- In_Tree => Project_Tree);
+ Shared => Project_Tree.Shared);
end if;
end if;
@@ -1973,7 +1976,7 @@ begin
when Prj.List =>
Current := The_Switches.Values;
while Current /= Prj.Nil_String loop
- The_String := Project_Tree.String_Elements.
+ The_String := Project_Tree.Shared.String_Elements.
Table (Current);
declare
@@ -2024,7 +2027,7 @@ begin
Prj.Util.Value_Of
(Name => Name_Compiler,
In_Packages => Project.Decl.Packages,
- In_Tree => Project_Tree);
+ Shared => Project_Tree.Shared);
Element : Package_Element;
@@ -2054,7 +2057,7 @@ begin
end if;
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
-- switches specified in the project file, use them.
@@ -2069,12 +2072,12 @@ begin
Prj.Util.Value_Of
(Name => Name_Switches,
In_Arrays => Element.Decl.Arrays,
- In_Tree => Project_Tree);
+ Shared => Project_Tree.Shared);
The_Switches := Prj.Util.Value_Of
(Index => Main_Id,
Src_Index => 0,
In_Array => Switches_Array,
- In_Tree => Project_Tree);
+ Shared => Project_Tree.Shared);
end if;
-- Otherwise, get the Default_Switches ("Ada")
@@ -2084,12 +2087,12 @@ begin
Prj.Util.Value_Of
(Name => Name_Default_Switches,
In_Arrays => Element.Decl.Arrays,
- In_Tree => Project_Tree);
+ Shared => Project_Tree.Shared);
The_Switches := Prj.Util.Value_Of
(Index => Name_Ada,
Src_Index => 0,
In_Array => Switches_Array,
- In_Tree => Project_Tree);
+ Shared => Project_Tree.Shared);
end if;
-- If there are switches specified, put them in the
@@ -2112,8 +2115,8 @@ begin
when Prj.List =>
Current := The_Switches.Values;
while Current /= Prj.Nil_String loop
- The_String :=
- Project_Tree.String_Elements.Table (Current);
+ The_String := Project_Tree.Shared.String_Elements
+ .Table (Current);
declare
Switch : constant String :=
@@ -2244,7 +2247,7 @@ begin
Prj.Util.Value_Of
(Name => Name_Builder,
In_Packages => Project.Decl.Packages,
- In_Tree => Project_Tree);
+ Shared => Project_Tree.Shared);
Variable : Variable_Value :=
Prj.Util.Value_Of
@@ -2252,7 +2255,7 @@ begin
Attribute_Or_Array_Name =>
Name_Global_Configuration_Pragmas,
In_Package => Pkg,
- In_Tree => Project_Tree);
+ Shared => Project_Tree.Shared);
begin
if (Variable = Nil_Variable_Value
@@ -2265,7 +2268,7 @@ begin
Attribute_Or_Array_Name =>
Name_Global_Config_File,
In_Package => Pkg,
- In_Tree => Project_Tree);
+ Shared => Project_Tree.Shared);
end if;
if Variable /= Nil_Variable_Value
@@ -2283,7 +2286,7 @@ begin
Prj.Util.Value_Of
(Name => Name_Compiler,
In_Packages => Project.Decl.Packages,
- In_Tree => Project_Tree);
+ Shared => Project_Tree.Shared);
Variable : Variable_Value :=
Prj.Util.Value_Of
@@ -2291,7 +2294,7 @@ begin
Attribute_Or_Array_Name =>
Name_Local_Configuration_Pragmas,
In_Package => Pkg,
- In_Tree => Project_Tree);
+ Shared => Project_Tree.Shared);
begin
if (Variable = Nil_Variable_Value
@@ -2304,7 +2307,7 @@ begin
Attribute_Or_Array_Name =>
Name_Local_Config_File,
In_Package => Pkg,
- In_Tree => Project_Tree);
+ Shared => Project_Tree.Shared);
end if;
if Variable /= Nil_Variable_Value
diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb
index d62ec018ac3..9d52a28d626 100644
--- a/gcc/ada/make.adb
+++ b/gcc/ada/make.adb
@@ -1288,7 +1288,8 @@ package body Make is
Switch_List := Switches.Values;
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);
if Name_Len > 0 then
@@ -2301,7 +2302,7 @@ package body Make is
Prj.Util.Value_Of
(Name => Name_Compiler,
In_Packages => Arguments_Project.Decl.Packages,
- In_Tree => Project_Tree);
+ Shared => Project_Tree.Shared);
if Compiler_Package /= No_Package then
@@ -2332,7 +2333,7 @@ package body Make is
begin
while Current /= Nil_String loop
- Element := Project_Tree.String_Elements.
+ Element := Project_Tree.Shared.String_Elements.
Table (Current);
Number := Number + 1;
Current := Element.Next;
@@ -2348,7 +2349,7 @@ package body Make is
Current := Switches.Values;
for Index in New_Args'Range loop
- Element := Project_Tree.String_Elements.
+ Element := Project_Tree.Shared.String_Elements.
Table (Current);
Get_Name_String (Element.Value);
@@ -3851,14 +3852,14 @@ package body Make is
Prj.Util.Value_Of
(Name => Name_Builder,
In_Packages => The_Packages,
- In_Tree => Project_Tree);
+ Shared => Project_Tree.Shared);
if Gnatmake /= No_Package then
Global_Attribute := Prj.Util.Value_Of
(Variable_Name => Name_Global_Configuration_Pragmas,
- In_Variables => Project_Tree.Packages.Table
+ In_Variables => Project_Tree.Shared.Packages.Table
(Gnatmake).Decl.Attributes,
- In_Tree => Project_Tree);
+ Shared => Project_Tree.Shared);
Global_Attribute_Present :=
Global_Attribute /= Nil_Variable_Value
and then Get_Name_String (Global_Attribute.Value) /= "";
@@ -3894,14 +3895,14 @@ package body Make is
Prj.Util.Value_Of
(Name => Name_Compiler,
In_Packages => The_Packages,
- In_Tree => Project_Tree);
+ Shared => Project_Tree.Shared);
if Compiler /= No_Package then
Local_Attribute := Prj.Util.Value_Of
(Variable_Name => Name_Local_Configuration_Pragmas,
- In_Variables => Project_Tree.Packages.Table
+ In_Variables => Project_Tree.Shared.Packages.Table
(Compiler).Decl.Attributes,
- In_Tree => Project_Tree);
+ Shared => Project_Tree.Shared);
Local_Attribute_Present :=
Local_Attribute /= Nil_Variable_Value
and then Get_Name_String (Local_Attribute.Value) /= "";
@@ -4183,7 +4184,7 @@ package body Make is
if Main_Project = No_Project then
GNAT.OS_Lib.Spawn (Globalizer_Path.all, Globalizer_Args, Success);
else
- Globalize_Dirs (Main_Project);
+ Globalize_Dirs (Main_Project, Project_Tree);
end if;
end Globalize;
@@ -4535,7 +4536,7 @@ package body Make is
Prj.Util.Value_Of
(Name_Languages,
Main_Project.Decl.Attributes,
- Project_Tree);
+ Project_Tree.Shared);
Current : String_List_Id;
Element : String_Element;
@@ -4551,7 +4552,7 @@ package body Make is
Current := Languages.Values;
Look_For_Foreign :
while Current /= Nil_String loop
- Element := Project_Tree.String_Elements.
+ Element := Project_Tree.Shared.String_Elements.
Table (Current);
Get_Name_String (Element.Value);
To_Lower (Name_Buffer (1 .. Name_Len));
@@ -4574,12 +4575,13 @@ package body Make is
-- line.
Get_Name_String
- (Project_Tree.String_Elements.Table (Value).Value);
+ (Project_Tree.Shared.String_Elements.Table
+ (Value).Value);
declare
Main_Name : constant String :=
Get_Name_String
- (Project_Tree.String_Elements.Table
+ (Project_Tree.Shared.String_Elements.Table
(Value).Value);
Proj : constant Project_Id :=
Prj.Env.Project_Of
@@ -4591,10 +4593,10 @@ package body Make is
At_Least_One_Main := True;
Osint.Add_File
(Get_Name_String
- (Project_Tree.String_Elements.Table
+ (Project_Tree.Shared.String_Elements.Table
(Value).Value),
Index =>
- Project_Tree.String_Elements.Table
+ Project_Tree.Shared.String_Elements.Table
(Value).Index);
elsif not Foreign_Language then
@@ -4605,7 +4607,7 @@ package body Make is
end if;
end;
- Value := Project_Tree.String_Elements.Table
+ Value := Project_Tree.Shared.String_Elements.Table
(Value).Next;
end loop;
@@ -4765,19 +4767,19 @@ package body Make is
Prj.Util.Value_Of
(Name => Name_Builder,
In_Packages => The_Packages,
- In_Tree => Project_Tree);
+ Shared => Project_Tree.Shared);
Binder_Package : constant Prj.Package_Id :=
Prj.Util.Value_Of
(Name => Name_Binder,
In_Packages => The_Packages,
- In_Tree => Project_Tree);
+ Shared => Project_Tree.Shared);
Linker_Package : constant Prj.Package_Id :=
Prj.Util.Value_Of
(Name => Name_Linker,
In_Packages => The_Packages,
- In_Tree => Project_Tree);
+ Shared => Project_Tree.Shared);
Default_Switches_Array : Array_Id;
@@ -4832,20 +4834,20 @@ package body Make is
Global_Compilation_Array := Prj.Util.Value_Of
(Name => Name_Global_Compilation_Switches,
- In_Arrays => Project_Tree.Packages.Table
+ In_Arrays => Project_Tree.Shared.Packages.Table
(Builder_Package).Decl.Arrays,
- In_Tree => Project_Tree);
+ Shared => Project_Tree.Shared);
Default_Switches_Array :=
- Project_Tree.Packages.Table
+ Project_Tree.Shared.Packages.Table
(Builder_Package).Decl.Arrays;
while Default_Switches_Array /= No_Array and then
- Project_Tree.Arrays.Table (Default_Switches_Array).Name /=
- Name_Default_Switches
+ Project_Tree.Shared.Arrays.Table (Default_Switches_Array).Name
+ /= Name_Default_Switches
loop
- Default_Switches_Array :=
- Project_Tree.Arrays.Table (Default_Switches_Array).Next;
+ Default_Switches_Array := Project_Tree.Shared.Arrays.Table
+ (Default_Switches_Array).Next;
end loop;
if Global_Compilation_Array /= No_Array_Element and then
@@ -4854,7 +4856,7 @@ package body Make is
Errutil.Error_Msg
("Default_Switches forbidden in presence of " &
"Global_Compilation_Switches. Use Switches instead.",
- Project_Tree.Arrays.Table
+ Project_Tree.Shared.Arrays.Table
(Default_Switches_Array).Location);
Errutil.Finalize;
Make_Failed
@@ -4899,15 +4901,15 @@ package body Make is
Name_Default_Switches,
In_Package =>
Builder_Package,
- In_Tree => Project_Tree);
+ Shared => Project_Tree.Shared);
Switches : constant Array_Element_Id :=
Prj.Util.Value_Of
(Name => Name_Switches,
In_Arrays =>
- Project_Tree.Packages.Table
+ Project_Tree.Shared.Packages.Table
(Builder_Package).Decl.Arrays,
- In_Tree => Project_Tree);
+ Shared => Project_Tree.Shared);
Other_Switches : constant Variable_Value :=
Prj.Util.Value_Of
@@ -4916,13 +4918,13 @@ package body Make is
Attribute_Or_Array_Name
=> Name_Switches,
In_Package => Builder_Package,
- In_Tree => Project_Tree);
+ Shared => Project_Tree.Shared);
begin
if Other_Switches /= Nil_Variable_Value then
if not Quiet_Output
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
then
Write_Line
@@ -4977,7 +4979,7 @@ package body Make is
begin
while Global_Compilation_Array /= No_Array_Element loop
Global_Compilation_Elem :=
- Project_Tree.Array_Elements.Table
+ Project_Tree.Shared.Array_Elements.Table
(Global_Compilation_Array);
Get_Name_String (Global_Compilation_Elem.Index);
@@ -4999,7 +5001,8 @@ package body Make is
while List /= Nil_String loop
Elem :=
- Project_Tree.String_Elements.Table (List);
+ Project_Tree.Shared.String_Elements.Table
+ (List);
if Elem.Value /= No_Name then
Add_Switch
@@ -5431,7 +5434,8 @@ package body Make is
Executable :=
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;
@@ -6337,13 +6341,13 @@ package body Make is
Prj.Util.Value_Of
(Name => Name_Binder,
In_Packages => The_Packages,
- In_Tree => Project_Tree);
+ Shared => Project_Tree.Shared);
Linker_Package : constant Prj.Package_Id :=
Prj.Util.Value_Of
(Name => Name_Linker,
In_Packages => The_Packages,
- In_Tree => Project_Tree);
+ Shared => Project_Tree.Shared);
begin
-- We fail if we cannot find the main source file
@@ -6848,7 +6852,7 @@ package body Make is
-- has its own directories anyway
Add_Source_Directories (Main_Project, Project_Tree);
- Add_Object_Directories (Main_Project);
+ Add_Object_Directories (Main_Project, Project_Tree);
Recursive_Compute_Depth (Main_Project);
Compute_All_Imported_Projects (Project_Tree);
@@ -8457,7 +8461,7 @@ package body Make is
(Source_File => Source_File,
Source_Lang => Name_Ada,
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,
Value => Switches,
Is_Default => Is_Default,
diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb
index 63731dd480b..6d82e4ba698 100644
--- a/gcc/ada/makeutl.adb
+++ b/gcc/ada/makeutl.adb
@@ -695,7 +695,7 @@ package body Makeutl is
Prj.Util.Value_Of
(Name => Pkg_Name,
In_Packages => Project.Decl.Packages,
- In_Tree => Project_Tree);
+ Shared => Project_Tree.Shared);
Lang : Language_Ptr;
begin
@@ -706,7 +706,7 @@ package body Makeutl is
(Name => Name_Id (Source_File),
Attribute_Or_Array_Name => Name_Switches,
In_Package => Pkg,
- In_Tree => Project_Tree,
+ Shared => Project_Tree.Shared,
Allow_Wildcards => True);
end if;
@@ -756,7 +756,7 @@ package body Makeutl is
(Name => Name_Find,
Attribute_Or_Array_Name => Name_Switches,
In_Package => Pkg,
- In_Tree => Project_Tree,
+ Shared => Project_Tree.Shared,
Allow_Wildcards => True);
end if;
@@ -776,7 +776,7 @@ package body Makeutl is
(Name => Name_Find,
Attribute_Or_Array_Name => Name_Switches,
In_Package => Pkg,
- In_Tree => Project_Tree,
+ Shared => Project_Tree.Shared,
Allow_Wildcards => True);
end if;
end;
@@ -790,7 +790,7 @@ package body Makeutl is
(Name => Source_Lang,
Attribute_Or_Array_Name => Name_Switches,
In_Package => Pkg,
- In_Tree => Project_Tree,
+ Shared => Project_Tree.Shared,
Force_Lower_Case_Index => True);
end if;
@@ -800,7 +800,7 @@ package body Makeutl is
(Name => All_Other_Names,
Attribute_Or_Array_Name => Name_Switches,
In_Package => Pkg,
- In_Tree => Project_Tree,
+ Shared => Project_Tree.Shared,
Force_Lower_Case_Index => True);
end if;
@@ -810,7 +810,7 @@ package body Makeutl is
(Name => Source_Lang,
Attribute_Or_Array_Name => Name_Default_Switches,
In_Package => Pkg,
- In_Tree => Project_Tree);
+ Shared => Project_Tree.Shared);
end if;
end Get_Switches;
@@ -910,14 +910,21 @@ package body Makeutl is
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return String_List
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
-------------------
-- 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);
Linker_Package : Package_Id;
@@ -928,7 +935,7 @@ package body Makeutl is
Prj.Util.Value_Of
(Name => Name_Linker,
In_Packages => Proj.Decl.Packages,
- In_Tree => In_Tree);
+ Shared => In_Tree.Shared);
Options :=
Prj.Util.Value_Of
@@ -936,7 +943,7 @@ package body Makeutl is
Index => 0,
Attribute_Or_Array_Name => Name_Linker_Options,
In_Package => Linker_Package,
- In_Tree => In_Tree);
+ Shared => In_Tree.Shared);
-- If attribute is present, add the project with
-- the attribute to table Linker_Opts.
@@ -958,7 +965,7 @@ package body Makeutl is
begin
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;
@@ -974,7 +981,7 @@ package body Makeutl is
begin
Options := Linker_Opts.Table (Index).Options;
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);
-- Do not consider empty linker options
@@ -991,7 +998,7 @@ package body Makeutl is
Including_L_Switch => True);
end if;
- Options := In_Tree.String_Elements.Table (Options).Next;
+ Options := In_Tree.Shared.String_Elements.Table (Options).Next;
end loop;
end;
end loop;
diff --git a/gcc/ada/makeutl.ads b/gcc/ada/makeutl.ads
index 325dd830d0e..f23291076ec 100644
--- a/gcc/ada/makeutl.ads
+++ b/gcc/ada/makeutl.ads
@@ -40,7 +40,8 @@ package Makeutl is
-- Failing procedure called from procedure Test_If_Relative_Path below. May
-- 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
Source_Info_Option : constant String := "--source-info=";
diff --git a/gcc/ada/mlib-prj.adb b/gcc/ada/mlib-prj.adb
index 656b9d4e824..af988ba78d3 100644
--- a/gcc/ada/mlib-prj.adb
+++ b/gcc/ada/mlib-prj.adb
@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -901,7 +901,7 @@ package body MLib.Prj is
Value_Of
(Name => Name_Binder,
In_Packages => For_Project.Decl.Packages,
- In_Tree => In_Tree);
+ Shared => In_Tree.Shared);
begin
if Binder_Package /= No_Package then
@@ -910,9 +910,9 @@ package body MLib.Prj is
Value_Of
(Name => Name_Default_Switches,
In_Arrays =>
- In_Tree.Packages.Table
+ In_Tree.Shared.Packages.Table
(Binder_Package).Decl.Arrays,
- In_Tree => In_Tree);
+ Shared => In_Tree.Shared);
Switches : Variable_Value := Nil_Variable_Value;
Switch : String_List_Id := Nil_String;
@@ -924,7 +924,7 @@ package body MLib.Prj is
(Index => Name_Ada,
Src_Index => 0,
In_Array => Defaults,
- In_Tree => In_Tree);
+ Shared => In_Tree.Shared);
if not Switches.Default then
Switch := Switches.Values;
@@ -932,9 +932,9 @@ package body MLib.Prj is
while Switch /= Nil_String loop
Add_Argument
(Get_Name_String
- (In_Tree.String_Elements.Table
+ (In_Tree.Shared.String_Elements.Table
(Switch).Value));
- Switch := In_Tree.String_Elements.
+ Switch := In_Tree.Shared.String_Elements.
Table (Switch).Next;
end loop;
end if;
@@ -1277,7 +1277,8 @@ package body MLib.Prj is
-- If attribute Library_Options was specified, add these options
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
declare
@@ -1287,7 +1288,7 @@ package body MLib.Prj is
begin
Current := Library_Options.Values;
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);
if Name_Len /= 0 then
@@ -1756,12 +1757,12 @@ package body MLib.Prj is
while Iface /= Nil_String loop
ALI :=
File_Name_Type
- (In_Tree.String_Elements.Table (Iface).Value);
+ (In_Tree.Shared.String_Elements.Table (Iface).Value);
Interface_ALIs.Set (ALI, True);
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));
- Iface := In_Tree.String_Elements.Table (Iface).Next;
+ Iface := In_Tree.Shared.String_Elements.Table (Iface).Next;
end loop;
Iface := For_Project.Lib_Interface_ALIs;
@@ -1775,9 +1776,10 @@ package body MLib.Prj is
while Iface /= Nil_String loop
ALI :=
File_Name_Type
- (In_Tree.String_Elements.Table (Iface).Value);
+ (In_Tree.Shared.String_Elements.Table (Iface).Value);
Process (ALI);
- Iface := In_Tree.String_Elements.Table (Iface).Next;
+ Iface :=
+ In_Tree.Shared.String_Elements.Table (Iface).Next;
end loop;
end if;
end;
diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb
index 978d4130ddf..3c39e6190a4 100644
--- a/gcc/ada/prj-conf.adb
+++ b/gcc/ada/prj-conf.adb
@@ -101,6 +101,17 @@ package body Prj.Conf is
pragma No_Return (Raise_Invalid_Config);
-- 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 --
--------------------
@@ -110,6 +121,7 @@ package body Prj.Conf is
Conf_Decl : Declarations;
User_Decl : in out Declarations)
is
+ Shared : constant Shared_Project_Tree_Data_Access := Project_Tree.Shared;
Conf_Attr_Id : Variable_Id;
Conf_Attr : Variable;
Conf_Array_Id : Array_Id;
@@ -130,10 +142,8 @@ package body Prj.Conf is
Conf_Attr_Id := Conf_Decl.Attributes;
User_Attr_Id := User_Decl.Attributes;
while Conf_Attr_Id /= No_Variable loop
- Conf_Attr :=
- Project_Tree.Variable_Elements.Table (Conf_Attr_Id);
- User_Attr :=
- Project_Tree.Variable_Elements.Table (User_Attr_Id);
+ Conf_Attr := Shared.Variable_Elements.Table (Conf_Attr_Id);
+ User_Attr := Shared.Variable_Elements.Table (User_Attr_Id);
if not Conf_Attr.Value.Default then
if User_Attr.Value.Default then
@@ -142,8 +152,7 @@ package body Prj.Conf is
-- value of the configuration attribute.
User_Attr.Value := Conf_Attr.Value;
- Project_Tree.Variable_Elements.Table (User_Attr_Id) :=
- User_Attr;
+ Shared.Variable_Elements.Table (User_Attr_Id) := User_Attr;
elsif User_Attr.Value.Kind = List
and then Conf_Attr.Value.Values /= Nil_String
@@ -164,22 +173,20 @@ package body Prj.Conf is
-- Create new list
String_Element_Table.Increment_Last
- (Project_Tree.String_Elements);
+ (Shared.String_Elements);
New_List := String_Element_Table.Last
- (Project_Tree.String_Elements);
+ (Shared.String_Elements);
-- Value of attribute is new list
User_Attr.Value.Values := New_List;
- Project_Tree.Variable_Elements.Table (User_Attr_Id) :=
- User_Attr;
+ Shared.Variable_Elements.Table (User_Attr_Id) := User_Attr;
loop
-- Get each element of configuration list
- Conf_Elem :=
- Project_Tree.String_Elements.Table (Conf_List);
+ Conf_Elem := Shared.String_Elements.Table (Conf_List);
New_Elem := Conf_Elem;
Conf_List := Conf_Elem.Next;
@@ -189,8 +196,7 @@ package body Prj.Conf is
-- first element of user list, and we are done.
New_Elem.Next := User_List;
- Project_Tree.String_Elements.Table
- (New_List) := New_Elem;
+ Shared.String_Elements.Table (New_List) := New_Elem;
exit;
else
@@ -198,12 +204,10 @@ package body Prj.Conf is
-- new list.
String_Element_Table.Increment_Last
- (Project_Tree.String_Elements);
+ (Shared.String_Elements);
New_Elem.Next :=
- String_Element_Table.Last
- (Project_Tree.String_Elements);
- Project_Tree.String_Elements.Table
- (New_List) := New_Elem;
+ String_Element_Table.Last (Shared.String_Elements);
+ Shared.String_Elements.Table (New_List) := New_Elem;
New_List := New_Elem.Next;
end if;
end loop;
@@ -217,11 +221,11 @@ package body Prj.Conf is
Conf_Array_Id := Conf_Decl.Arrays;
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;
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;
User_Array_Id := User_Array.Next;
end loop;
@@ -230,11 +234,11 @@ package body Prj.Conf is
-- do a shallow copy of the full associative array.
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.Next := User_Decl.Arrays;
- User_Decl.Arrays := Array_Table.Last (Project_Tree.Arrays);
- Project_Tree.Arrays.Table (User_Decl.Arrays) := User_Array;
+ User_Decl.Arrays := Array_Table.Last (Shared.Arrays);
+ Shared.Arrays.Table (User_Decl.Arrays) := User_Array;
else
-- Otherwise, check each array element
@@ -242,12 +246,12 @@ package body Prj.Conf is
Conf_Array_Elem_Id := Conf_Array.Value;
while Conf_Array_Elem_Id /= No_Array_Element loop
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;
while User_Array_Elem_Id /= No_Array_Element loop
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;
User_Array_Elem_Id := User_Array_Elem.Next;
end loop;
@@ -257,15 +261,14 @@ package body Prj.Conf is
-- user array.
if User_Array_Elem_Id = No_Array_Element then
- Array_Element_Table.Increment_Last
- (Project_Tree.Array_Elements);
+ Array_Element_Table.Increment_Last (Shared.Array_Elements);
User_Array_Elem := Conf_Array_Elem;
User_Array_Elem.Next := User_Array.Value;
User_Array.Value :=
- Array_Element_Table.Last (Project_Tree.Array_Elements);
- Project_Tree.Array_Elements.Table (User_Array.Value) :=
+ Array_Element_Table.Last (Shared.Array_Elements);
+ Shared.Array_Elements.Table (User_Array.Value) :=
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
-- user array element with the conf array element value.
@@ -283,23 +286,22 @@ package body Prj.Conf is
begin
loop
Conf_List_Elem :=
- Project_Tree.String_Elements.Table
- (Conf_List);
+ Shared.String_Elements.Table (Conf_List);
String_Element_Table.Increment_Last
- (Project_Tree.String_Elements);
+ (Shared.String_Elements);
Next :=
String_Element_Table.Last
- (Project_Tree.String_Elements);
- Project_Tree.String_Elements.Table (Next) :=
+ (Shared.String_Elements);
+ Shared.String_Elements.Table (Next) :=
Conf_List_Elem;
if Previous = Nil_String then
User_Array_Elem.Value.Values := Next;
- Project_Tree.Array_Elements.Table
+ Shared.Array_Elements.Table
(User_Array_Elem_Id) := User_Array_Elem;
else
- Project_Tree.String_Elements.Table
+ Shared.String_Elements.Table
(Previous).Next := Next;
end if;
@@ -308,8 +310,8 @@ package body Prj.Conf is
Conf_List := Conf_List_Elem.Next;
if Conf_List = Nil_String then
- Project_Tree.String_Elements.Table
- (Previous).Next := Link;
+ Shared.String_Elements.Table (Previous).Next :=
+ Link;
exit;
end if;
end loop;
@@ -454,9 +456,10 @@ package body Prj.Conf is
-----------------------
procedure Apply_Config_File
- (Config_File : Prj.Project_Id;
- Project_Tree : Prj.Project_Tree_Ref)
+ (Config_File : Prj.Project_Id;
+ Project_Tree : Prj.Project_Tree_Ref)
is
+ Shared : constant Shared_Project_Tree_Data_Access := Project_Tree.Shared;
Conf_Decl : constant Declarations := Config_File.Decl;
Conf_Pack_Id : Package_Id;
Conf_Pack : Package_Element;
@@ -467,47 +470,67 @@ package body Prj.Conf is
Proj : Project_List;
begin
+ Debug_Output ("Applying config file to a project tree");
+
Proj := Project_Tree.Projects;
while Proj /= null loop
if Proj.Project /= Config_File then
User_Decl := Proj.Project.Decl;
Add_Attributes
- (Project_Tree => Project_Tree,
- Conf_Decl => Conf_Decl,
- User_Decl => User_Decl);
+ (Project_Tree => Project_Tree,
+ Conf_Decl => Conf_Decl,
+ User_Decl => User_Decl);
Conf_Pack_Id := Conf_Decl.Packages;
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;
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;
User_Pack_Id := User_Pack.Next;
end loop;
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.Next := User_Decl.Packages;
- User_Decl.Packages :=
- Package_Table.Last (Project_Tree.Packages);
- Project_Tree.Packages.Table (User_Decl.Packages) :=
- User_Pack;
+ User_Decl.Packages := Package_Table.Last (Shared.Packages);
+ Shared.Packages.Table (User_Decl.Packages) := User_Pack;
else
Add_Attributes
- (Project_Tree => Project_Tree,
- Conf_Decl => Conf_Pack.Decl,
- User_Decl => Project_Tree.Packages.Table
- (User_Pack_Id).Decl);
+ (Project_Tree => Project_Tree,
+ Conf_Decl => Conf_Pack.Decl,
+ User_Decl =>
+ Shared.Packages.Table (User_Pack_Id).Decl);
end if;
Conf_Pack_Id := Conf_Pack.Next;
end loop;
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;
Proj := Proj.Next;
@@ -524,9 +547,10 @@ package body Prj.Conf is
Project_Tree : Prj.Project_Tree_Ref;
Target : String := "") return Boolean
is
+ Shared : constant Shared_Project_Tree_Data_Access := Project_Tree.Shared;
Variable : constant Variable_Value :=
Value_Of
- (Name_Target, Config_File.Decl.Attributes, Project_Tree);
+ (Name_Target, Config_File.Decl.Attributes, Shared);
Tgt_Name : Name_Id := No_Name;
OK : Boolean;
@@ -585,6 +609,7 @@ package body Prj.Conf is
Automatically_Generated : out Boolean;
On_Load_Config : Config_File_Hook := null)
is
+ Shared : constant Shared_Project_Tree_Data_Access := Project_Tree.Shared;
At_Least_One_Compiler_Command : Boolean := False;
-- Set to True if at least one attribute Ide'Compiler_Command is
@@ -655,7 +680,7 @@ package body Prj.Conf is
Value_Of
(Name_Source_Dirs,
Project.Decl.Attributes,
- Project_Tree);
+ Shared);
if Variable = Nil_Variable_Value
or else Variable.Default
@@ -665,7 +690,7 @@ package body Prj.Conf is
Value_Of
(Name_Source_Files,
Project.Decl.Attributes,
- Project_Tree);
+ Shared);
return Variable = Nil_Variable_Value
or else Variable.Default
or else Variable.Values /= Nil_String;
@@ -690,10 +715,7 @@ package body Prj.Conf is
-- Hash table to keep the languages used in the project tree
IDE : constant Package_Id :=
- Value_Of
- (Name_Ide,
- Project.Decl.Packages,
- Project_Tree);
+ Value_Of (Name_Ide, Project.Decl.Packages, Shared);
Prj_Iter : Project_List;
List : String_List_Id;
@@ -714,7 +736,7 @@ package body Prj.Conf is
Value_Of
(Name_Languages,
Prj_Iter.Project.Decl.Attributes,
- Project_Tree);
+ Shared);
if Variable = Nil_Variable_Value
or else Variable.Default
@@ -730,7 +752,7 @@ package body Prj.Conf is
Value_Of
(Name_Languages,
Prj_Iter.Project.Extends.Decl.Attributes,
- Project_Tree);
+ Shared);
Check_Default :=
Variable /= Nil_Variable_Value
and then Variable.Values = Nil_String;
@@ -741,7 +763,7 @@ package body Prj.Conf is
Value_Of
(Name_Default_Language,
Prj_Iter.Project.Decl.Attributes,
- Project_Tree);
+ Shared);
if Variable /= Nil_Variable_Value
and then not Variable.Default
@@ -765,7 +787,7 @@ package body Prj.Conf is
List := Variable.Values;
while List /= Nil_String loop
- Elem := Project_Tree.String_Elements.Table (List);
+ Elem := Shared.String_Elements.Table (List);
Get_Name_String (Elem.Value);
To_Lower (Name_Buffer (1 .. Name_Len));
@@ -800,7 +822,7 @@ package body Prj.Conf is
(Name,
Attribute_Or_Array_Name => Name_Compiler_Command,
In_Package => IDE,
- In_Tree => Project_Tree,
+ Shared => Shared,
Force_Lower_Case_Index => True);
declare
@@ -857,7 +879,7 @@ package body Prj.Conf is
Value_Of
(Name_Object_Dir,
Project.Decl.Attributes,
- Project_Tree);
+ Shared);
Gprconfig_Path : String_Access;
Success : Boolean;
@@ -1261,6 +1283,7 @@ package body Prj.Conf is
On_Load_Config : Config_File_Hook := null;
Reset_Tree : Boolean := True)
is
+ Shared : constant Shared_Project_Tree_Data_Access := Project_Tree.Shared;
Main_Config_Project : Project_Id;
Success : Boolean;
@@ -1289,7 +1312,7 @@ package body Prj.Conf is
Value_Of
(Name_Object_Dir,
Main_Project.Decl.Attributes,
- Project_Tree);
+ Shared);
begin
if Obj_Dir = Nil_Variable_Value or else Obj_Dir.Default then
diff --git a/gcc/ada/prj-conf.ads b/gcc/ada/prj-conf.ads
index af331846ce4..38e46bef426 100644
--- a/gcc/ada/prj-conf.ads
+++ b/gcc/ada/prj-conf.ads
@@ -162,17 +162,6 @@ package Prj.Conf is
-- processed (and Packages_To_Check is used to indicate which packages
-- 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
(Config_File : in out Prj.Tree.Project_Node_Id;
Project_Tree : Prj.Tree.Project_Node_Tree_Ref);
diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb
index 222efe021bf..b5102c74f99 100644
--- a/gcc/ada/prj-env.adb
+++ b/gcc/ada/prj-env.adb
@@ -76,7 +76,7 @@ package body Prj.Env is
procedure Add_To_Path
(Source_Dirs : String_List_Id;
- In_Tree : Project_Tree_Ref;
+ Shared : Shared_Project_Tree_Data_Access;
Buffer : in out String_Access;
Buffer_Last : in out Natural);
-- Add to Ada_Path_Buffer all the source directories in string list
@@ -91,7 +91,7 @@ package body Prj.Env is
procedure Add_To_Source_Path
(Source_Dirs : String_List_Id;
- In_Tree : Project_Tree_Ref;
+ Shared : Shared_Project_Tree_Data_Access;
Source_Paths : in out Source_Path_Table.Instance);
-- Add to Ada_Path_B all the source directories in string list
-- Source_Dirs, if any. Increment Ada_Path_Length.
@@ -122,17 +122,25 @@ package body Prj.Env is
Buffer : String_Access;
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 --
---------
- 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);
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;
procedure For_All_Projects is
@@ -150,7 +158,8 @@ package body Prj.Env is
if Project.Ada_Include_Path = null then
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));
Free (Buffer);
end if;
@@ -159,7 +168,8 @@ package body Prj.Env is
else
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
Result : constant String := Buffer (1 .. Buffer_Last);
@@ -176,20 +186,28 @@ package body Prj.Env is
function Ada_Objects_Path
(Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
Including_Libraries : Boolean := True) return String_Access
is
Buffer : String_Access;
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 --
---------
- procedure Add (Project : Project_Id; Dummy : in out Boolean) is
- pragma Unreferenced (Dummy);
+ procedure Add
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ Dummy : in out Boolean)
+ is
+ pragma Unreferenced (Dummy, In_Tree);
Path : constant Path_Name_Type :=
Get_Object_Directory
(Project,
@@ -214,7 +232,7 @@ package body Prj.Env is
if Project.Ada_Objects_Path = null then
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));
Free (Buffer);
@@ -291,7 +309,7 @@ package body Prj.Env is
procedure Add_To_Path
(Source_Dirs : String_List_Id;
- In_Tree : Project_Tree_Ref;
+ Shared : Shared_Project_Tree_Data_Access;
Buffer : in out String_Access;
Buffer_Last : in out Natural)
is
@@ -299,7 +317,7 @@ package body Prj.Env is
Source_Dir : String_Element;
begin
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),
Buffer, Buffer_Last);
Current := Source_Dir.Next;
@@ -395,7 +413,7 @@ package body Prj.Env is
procedure Add_To_Source_Path
(Source_Dirs : String_List_Id;
- In_Tree : Project_Tree_Ref;
+ Shared : Shared_Project_Tree_Data_Access;
Source_Paths : in out Source_Path_Table.Instance)
is
Current : String_List_Id := Source_Dirs;
@@ -406,7 +424,7 @@ package body Prj.Env is
-- Add each source directory
while Current /= Nil_String loop
- Source_Dir := In_Tree.String_Elements.Table (Current);
+ Source_Dir := Shared.String_Elements.Table (Current);
Add_It := True;
-- Check if the source directory is already in the table
@@ -461,7 +479,10 @@ package body Prj.Env is
Iter : Source_Iterator;
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
-- standard naming schemes, if it is not already in the file, then call
-- itself for any imported project.
@@ -482,23 +503,24 @@ package body Prj.Env is
-- Check --
-----------
- procedure Check (Project : Project_Id; State : in out Integer) is
- pragma Unreferenced (State);
+ procedure Check
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ State : in out Integer)
+ is
+ pragma Unreferenced (State, In_Tree);
Lang : constant Language_Ptr :=
Get_Language_From_Name (Project, "ada");
Naming : Lang_Naming_Data;
begin
if Current_Verbosity = High then
- Write_Str ("Checking project file """);
- Write_Str (Namet.Get_Name_String (Project.Name));
- Write_Str (""".");
- Write_Eol;
+ Debug_Output ("Checking project file:", Project.Name);
end if;
if Lang = null 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;
return;
@@ -665,7 +687,8 @@ package body Prj.Env is
-- 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
@@ -767,7 +790,10 @@ package body Prj.Env is
procedure Put_Name_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)
---------------------
@@ -789,7 +815,11 @@ package body Prj.Env is
-- 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);
Source : Source_Id;
Suffix : File_Name_Type;
@@ -874,7 +904,7 @@ package body Prj.Env is
Debug_Increase_Indent ("Create mapping file ", Name_Id (Name));
end if;
- For_Every_Imported_Project (Project, Dummy);
+ For_Every_Imported_Project (Project, In_Tree, Dummy);
declare
Last : Natural;
@@ -1174,16 +1204,26 @@ package body Prj.Env is
-- For_All_Object_Dirs --
-------------------------
- procedure For_All_Object_Dirs (Project : Project_Id) is
- procedure For_Project (Prj : Project_Id; Dummy : in out Integer);
+ procedure For_All_Object_Dirs
+ (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
-----------------
-- For_Project --
-----------------
- procedure For_Project (Prj : Project_Id; Dummy : in out Integer) is
- pragma Unreferenced (Dummy);
+ procedure For_Project
+ (Prj : Project_Id;
+ Tree : Project_Tree_Ref;
+ Dummy : in out Integer)
+ is
+ pragma Unreferenced (Dummy, Tree);
begin
-- ??? Set_Ada_Paths has a different behavior for library project
-- files, should we have the same ?
@@ -1201,7 +1241,7 @@ package body Prj.Env is
-- Start of processing for For_All_Object_Dirs
begin
- Get_Object_Dirs (Project, Dummy);
+ Get_Object_Dirs (Project, Tree, Dummy);
end For_All_Object_Dirs;
-------------------------
@@ -1212,14 +1252,21 @@ package body Prj.Env is
(Project : Project_Id;
In_Tree : Project_Tree_Ref)
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
-----------------
-- 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);
Current : String_List_Id := Prj.Source_Dirs;
The_String : String_Element;
@@ -1230,7 +1277,7 @@ package body Prj.Env is
if Has_Ada_Sources (Project) then
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));
Current := The_String.Next;
end loop;
@@ -1244,7 +1291,7 @@ package body Prj.Env is
-- Start of processing for For_All_Source_Dirs
begin
- Get_Source_Dirs (Project, Dummy);
+ Get_Source_Dirs (Project, In_Tree, Dummy);
end For_All_Source_Dirs;
-------------------
@@ -1541,7 +1588,10 @@ package body Prj.Env is
Buffer : String_Access := new String (1 .. Buffer_Initial);
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/
-- imported projects.
@@ -1549,7 +1599,11 @@ package body Prj.Env is
-- 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);
Path : Path_Name_Type;
@@ -1563,7 +1617,8 @@ package body Prj.Env is
-- Ada sources.
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;
@@ -1621,7 +1676,7 @@ package body Prj.Env is
-- then call the recursive procedure Add for Project.
if Process_Source_Dirs or Process_Object_Dirs then
- For_All_Projects (Project, Dummy);
+ For_All_Projects (Project, In_Tree, Dummy);
end if;
-- Write and close any file that has been created. Source_FD is not set
diff --git a/gcc/ada/prj-env.ads b/gcc/ada/prj-env.ads
index 99bd88064fe..2be3cfe9407 100644
--- a/gcc/ada/prj-env.ads
+++ b/gcc/ada/prj-env.ads
@@ -88,6 +88,7 @@ package Prj.Env is
function Ada_Objects_Path
(Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
Including_Libraries : Boolean := True) return String_Access;
-- 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
@@ -149,7 +150,9 @@ package Prj.Env is
generic
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
-- of imported or modified projects.
diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb
index 743a1fc79ca..bc6c8ec9919 100644
--- a/gcc/ada/prj-nmsc.adb
+++ b/gcc/ada/prj-nmsc.adb
@@ -507,7 +507,8 @@ package body Prj.Nmsc is
-- when there are no sources for language Lang_Name.
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
procedure Write_Attr (Name, Value : String);
@@ -651,7 +652,6 @@ package body Prj.Nmsc is
Add_Src : Boolean;
Source : Source_Id;
Prev_Unit : Unit_Index := No_Unit_Index;
-
Source_To_Replace : Source_Id := No_Source;
begin
@@ -939,7 +939,7 @@ package body Prj.Nmsc is
Prj.Util.Value_Of
(Snames.Name_Project_Files,
Project.Decl.Attributes,
- Tree);
+ Tree.Shared);
Project_Path_For_Aggregate : Prj.Env.Project_Search_Path;
@@ -958,22 +958,27 @@ package body Prj.Nmsc is
procedure Found_Project_File (Path : Path_Information; Rank : Natural) is
pragma Unreferenced (Rank);
begin
- 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
- -- can only do this when processing the aggregate project, since 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
- -- 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
-
- Add_Aggregated_Project (Project, Path => Path.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
+ -- can only do this when processing the aggregate project, since
+ -- 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
+ -- 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
+
+ Add_Aggregated_Project (Project, Path => Path.Name);
+
+ else
+ Debug_Output ("Pattern returned the aggregate itself, ignored");
+ end if;
end Found_Project_File;
-- Start of processing for Check_Aggregate_Project
@@ -1021,22 +1026,24 @@ package body Prj.Nmsc is
(Project : Project_Id;
Data : in out Tree_Processing_Data)
is
+ Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
+
Source_Dirs : constant Variable_Value :=
Util.Value_Of
(Name_Source_Dirs,
- Project.Decl.Attributes, Data.Tree);
+ Project.Decl.Attributes, Shared);
Source_Files : constant Variable_Value :=
Util.Value_Of
(Name_Source_Files,
- Project.Decl.Attributes, Data.Tree);
+ Project.Decl.Attributes, Shared);
Source_List_File : constant Variable_Value :=
Util.Value_Of
(Name_Source_List_File,
- Project.Decl.Attributes, Data.Tree);
+ Project.Decl.Attributes, Shared);
Languages : constant Variable_Value :=
Util.Value_Of
(Name_Languages,
- Project.Decl.Attributes, Data.Tree);
+ Project.Decl.Attributes, Shared);
begin
if Project.Source_Dirs /= Nil_String then
@@ -1065,6 +1072,7 @@ package body Prj.Nmsc is
(Project : Project_Id;
Data : in out Tree_Processing_Data)
is
+ Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
Prj_Data : Project_Processing_Data;
begin
@@ -1079,7 +1087,7 @@ package body Prj.Nmsc is
Check_Programming_Languages (Project, Data);
if Current_Verbosity = High then
- Show_Source_Dirs (Project, Data.Tree);
+ Show_Source_Dirs (Project, Shared);
end if;
end if;
@@ -1303,6 +1311,9 @@ package body Prj.Nmsc is
(Project : Project_Id;
Data : in out Tree_Processing_Data)
is
+ Shared : constant Shared_Project_Tree_Data_Access :=
+ Data.Tree.Shared;
+
Dot_Replacement : File_Name_Type := No_File;
Casing : Casing_Type := All_Lower_Case;
Separate_Suffix : File_Name_Type := No_File;
@@ -1364,11 +1375,11 @@ package body Prj.Nmsc is
Current_Array_Id := Arrays;
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;
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
@@ -1441,8 +1452,7 @@ package body Prj.Nmsc is
Attribute_Id := Attributes;
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 Attribute.Name = Name_Executable_Suffix then
@@ -1475,11 +1485,11 @@ package body Prj.Nmsc is
Current_Array_Id := Arrays;
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;
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
@@ -1806,7 +1816,7 @@ package body Prj.Nmsc is
Attribute_Id := Attributes;
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 Attribute.Name = Name_Separate_Suffix then
@@ -1857,11 +1867,11 @@ package body Prj.Nmsc is
Current_Array_Id := Arrays;
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;
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
@@ -1918,8 +1928,7 @@ package body Prj.Nmsc is
Attribute_Id := Attributes;
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 Attribute.Name = Name_Driver then
@@ -2026,7 +2035,7 @@ package body Prj.Nmsc is
begin
Packages := Project.Decl.Packages;
while Packages /= No_Package loop
- Element := Data.Tree.Packages.Table (Packages);
+ Element := Shared.Packages.Table (Packages);
case Element.Name is
when Name_Binder =>
@@ -2082,8 +2091,7 @@ package body Prj.Nmsc is
Attribute_Id := Project.Decl.Attributes;
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 Attribute.Name = Name_Target then
@@ -2400,11 +2408,11 @@ package body Prj.Nmsc is
Current_Array_Id := Project.Decl.Arrays;
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;
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
@@ -2684,10 +2692,11 @@ package body Prj.Nmsc is
(Project : Project_Id;
Data : in out Tree_Processing_Data)
is
+ Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
Externally_Built : constant Variable_Value :=
Util.Value_Of
(Name_Externally_Built,
- Project.Decl.Attributes, Data.Tree);
+ Project.Decl.Attributes, Shared);
begin
if not Externally_Built.Default then
@@ -2726,17 +2735,19 @@ package body Prj.Nmsc is
(Project : Project_Id;
Data : in out Tree_Processing_Data)
is
+ Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
+
Interfaces : constant Prj.Variable_Value :=
Prj.Util.Value_Of
(Snames.Name_Interfaces,
Project.Decl.Attributes,
- Data.Tree);
+ Shared);
Library_Interface : constant Prj.Variable_Value :=
Prj.Util.Value_Of
(Snames.Name_Library_Interface,
Project.Decl.Attributes,
- Data.Tree);
+ Shared);
List : String_List_Id;
Element : String_Element;
@@ -2767,7 +2778,7 @@ package body Prj.Nmsc is
List := Interfaces.Values;
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);
Project_2 := Project;
@@ -2840,7 +2851,7 @@ package body Prj.Nmsc is
List := Library_Interface.Values;
while List /= Nil_String loop
- Element := Data.Tree.String_Elements.Table (List);
+ Element := Shared.String_Elements.Table (List);
Get_Name_String (Element.Value);
To_Lower (Name_Buffer (1 .. Name_Len));
Name := Name_Find;
@@ -2913,9 +2924,10 @@ package body Prj.Nmsc is
(Project : Project_Id;
Data : in out Tree_Processing_Data)
is
+ Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
Naming_Id : constant Package_Id :=
Util.Value_Of
- (Name_Naming, Project.Decl.Packages, Data.Tree);
+ (Name_Naming, Project.Decl.Packages, Shared);
Naming : Package_Element;
Ada_Body_Suffix_Loc : Source_Ptr := No_Location;
@@ -2957,17 +2969,17 @@ package body Prj.Nmsc is
Util.Value_Of
(Name_Dot_Replacement,
Naming.Decl.Attributes,
- Data.Tree);
+ Shared);
Casing_String : constant Variable_Value :=
Util.Value_Of
(Name_Casing,
Naming.Decl.Attributes,
- Data.Tree);
+ Shared);
Sep_Suffix : constant Variable_Value :=
Util.Value_Of
(Name_Separate_Suffix,
Naming.Decl.Attributes,
- Data.Tree);
+ Shared);
Dot_Repl_Loc : Source_Ptr;
begin
@@ -3105,26 +3117,26 @@ package body Prj.Nmsc is
Value_Of
(Name_Implementation_Exceptions,
In_Arrays => Naming.Decl.Arrays,
- In_Tree => Data.Tree);
+ Shared => Shared);
when Spec =>
Exceptions :=
Value_Of
(Name_Specification_Exceptions,
In_Arrays => Naming.Decl.Arrays,
- In_Tree => Data.Tree);
+ Shared => Shared);
end case;
Exception_List :=
Value_Of
(Index => Lang,
In_Array => Exceptions,
- In_Tree => Data.Tree);
+ Shared => Shared);
if Exception_List /= Nil_Variable_Value then
Element_Id := Exception_List.Values;
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);
Source :=
@@ -3200,14 +3212,14 @@ package body Prj.Nmsc is
Value_Of
(Name_Body,
In_Arrays => Naming.Decl.Arrays,
- In_Tree => Data.Tree);
+ Shared => Shared);
if Exceptions = No_Array_Element then
Exceptions :=
Value_Of
(Name_Implementation,
In_Arrays => Naming.Decl.Arrays,
- In_Tree => Data.Tree);
+ Shared => Shared);
end if;
when Spec =>
@@ -3215,19 +3227,19 @@ package body Prj.Nmsc is
Value_Of
(Name_Spec,
In_Arrays => Naming.Decl.Arrays,
- In_Tree => Data.Tree);
+ Shared => Shared);
if Exceptions = No_Array_Element then
Exceptions :=
Value_Of
(Name_Spec,
In_Arrays => Naming.Decl.Arrays,
- In_Tree => Data.Tree);
+ Shared => Shared);
end if;
end case;
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);
Get_Name_String (Element.Index);
@@ -3332,14 +3344,14 @@ package body Prj.Nmsc is
(Name => Lang,
Attribute_Or_Array_Name => Name_Spec_Suffix,
In_Package => Naming_Id,
- In_Tree => Data.Tree);
+ Shared => Shared);
if Suffix = Nil_Variable_Value then
Suffix := Value_Of
(Name => Lang,
Attribute_Or_Array_Name => Name_Specification_Suffix,
In_Package => Naming_Id,
- In_Tree => Data.Tree);
+ Shared => Shared);
end if;
if Suffix /= Nil_Variable_Value then
@@ -3364,7 +3376,7 @@ package body Prj.Nmsc is
(Name => Lang,
Attribute_Or_Array_Name => Name_Body_Suffix,
In_Package => Naming_Id,
- In_Tree => Data.Tree);
+ Shared => Shared);
if Suffix = Nil_Variable_Value then
Suffix :=
@@ -3372,7 +3384,7 @@ package body Prj.Nmsc is
(Name => Lang,
Attribute_Or_Array_Name => Name_Implementation_Suffix,
In_Package => Naming_Id,
- In_Tree => Data.Tree);
+ Shared => Shared);
end if;
if Suffix /= Nil_Variable_Value then
@@ -3470,13 +3482,13 @@ package body Prj.Nmsc is
Util.Value_Of
(Name_Spec_Suffix,
Naming.Decl.Arrays,
- Data.Tree);
+ Shared);
Impls : Array_Element_Id :=
Util.Value_Of
(Name_Body_Suffix,
Naming.Decl.Arrays,
- Data.Tree);
+ Shared);
Lang : Language_Ptr;
Lang_Name : Name_Id;
@@ -3489,7 +3501,7 @@ package body Prj.Nmsc is
-- user project, and they override the default.
while Specs /= No_Array_Element loop
- Lang_Name := Data.Tree.Array_Elements.Table (Specs).Index;
+ Lang_Name := Shared.Array_Elements.Table (Specs).Index;
Lang :=
Get_Language_From_Name
(Project, Name => Get_Name_String (Lang_Name));
@@ -3523,7 +3535,7 @@ package body Prj.Nmsc is
Lang_Name);
else
- Value := Data.Tree.Array_Elements.Table (Specs).Value;
+ Value := Shared.Array_Elements.Table (Specs).Value;
if Value.Kind = Single then
Lang.Config.Naming_Data.Spec_Suffix :=
@@ -3531,11 +3543,11 @@ package body Prj.Nmsc is
end if;
end if;
- Specs := Data.Tree.Array_Elements.Table (Specs).Next;
+ Specs := Shared.Array_Elements.Table (Specs).Next;
end 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 :=
Get_Language_From_Name
(Project, Name => Get_Name_String (Lang_Name));
@@ -3545,7 +3557,7 @@ package body Prj.Nmsc is
("Ignoring impl naming data (lang. not in project): ",
Lang_Name);
else
- Value := Data.Tree.Array_Elements.Table (Impls).Value;
+ Value := Shared.Array_Elements.Table (Impls).Value;
if Lang.Name = Name_Ada then
Ada_Body_Suffix_Loc := Value.Location;
@@ -3557,7 +3569,7 @@ package body Prj.Nmsc is
end if;
end if;
- Impls := Data.Tree.Array_Elements.Table (Impls).Next;
+ Impls := Shared.Array_Elements.Table (Impls).Next;
end loop;
end Initialize_Naming_Data;
@@ -3569,7 +3581,7 @@ package body Prj.Nmsc is
if Naming_Id /= No_Package
and then Project.Qualifier /= Configuration
then
- Naming := Data.Tree.Packages.Table (Naming_Id);
+ Naming := Shared.Packages.Table (Naming_Id);
Debug_Increase_Indent ("Checking package Naming for ", Project.Name);
Initialize_Naming_Data;
Check_Naming;
@@ -3585,31 +3597,33 @@ package body Prj.Nmsc is
(Project : Project_Id;
Data : in out Tree_Processing_Data)
is
+ Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
+
Attributes : constant Prj.Variable_Id := Project.Decl.Attributes;
Lib_Dir : constant Prj.Variable_Value :=
Prj.Util.Value_Of
- (Snames.Name_Library_Dir, Attributes, Data.Tree);
+ (Snames.Name_Library_Dir, Attributes, Shared);
Lib_Name : constant Prj.Variable_Value :=
Prj.Util.Value_Of
- (Snames.Name_Library_Name, Attributes, Data.Tree);
+ (Snames.Name_Library_Name, Attributes, Shared);
Lib_Version : constant Prj.Variable_Value :=
Prj.Util.Value_Of
- (Snames.Name_Library_Version, Attributes, Data.Tree);
+ (Snames.Name_Library_Version, Attributes, Shared);
Lib_ALI_Dir : constant Prj.Variable_Value :=
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 :=
Prj.Util.Value_Of
- (Snames.Name_Library_GCC, Attributes, Data.Tree);
+ (Snames.Name_Library_GCC, Attributes, Shared);
The_Lib_Kind : constant Prj.Variable_Value :=
Prj.Util.Value_Of
- (Snames.Name_Library_Kind, Attributes, Data.Tree);
+ (Snames.Name_Library_Kind, Attributes, Shared);
Imported_Project_List : Project_List;
@@ -3839,7 +3853,7 @@ package body Prj.Nmsc is
Dirs_Id := Project.Source_Dirs;
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;
if Project.Library_Dir.Name =
@@ -3871,7 +3885,7 @@ package body Prj.Nmsc is
Dir_Loop : while Dirs_Id /= Nil_String loop
Dir_Elem :=
- Data.Tree.String_Elements.Table (Dirs_Id);
+ Shared.String_Elements.Table (Dirs_Id);
Dirs_Id := Dir_Elem.Next;
if Project.Library_Dir.Name =
@@ -4027,8 +4041,7 @@ package body Prj.Nmsc is
Dirs_Id := Project.Source_Dirs;
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;
if Project.Library_ALI_Dir.Name =
@@ -4061,8 +4074,7 @@ package body Prj.Nmsc is
ALI_Dir_Loop :
while Dirs_Id /= Nil_String loop
Dir_Elem :=
- Data.Tree.String_Elements.Table
- (Dirs_Id);
+ Shared.String_Elements.Table (Dirs_Id);
Dirs_Id := Dir_Elem.Next;
if Project.Library_ALI_Dir.Name =
@@ -4178,14 +4190,14 @@ package body Prj.Nmsc is
Value_Of
(Name_Linker,
Project.Decl.Packages,
- Data.Tree);
+ Shared);
Driver : constant Variable_Value :=
Value_Of
(Name => No_Name,
Attribute_Or_Array_Name =>
Name_Driver,
In_Package => Linker,
- In_Tree => Data.Tree);
+ Shared => Shared);
begin
if Driver /= Nil_Variable_Value
@@ -4227,26 +4239,26 @@ package body Prj.Nmsc is
Linker_Package_Id : constant Package_Id :=
Util.Value_Of
(Name_Linker,
- Project.Decl.Packages, Data.Tree);
+ Project.Decl.Packages, Shared);
Linker_Package : Package_Element;
Switches : Array_Element_Id := No_Array_Element;
begin
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 :=
Value_Of
(Name => Name_Switches,
In_Arrays => Linker_Package.Decl.Arrays,
- In_Tree => Data.Tree);
+ Shared => Shared);
if Switches = No_Array_Element then
Switches :=
Value_Of
(Name => Name_Default_Switches,
In_Arrays => Linker_Package.Decl.Arrays,
- In_Tree => Data.Tree);
+ Shared => Shared);
end if;
if Switches /= No_Array_Element then
@@ -4310,6 +4322,8 @@ package body Prj.Nmsc is
(Project : Project_Id;
Data : in out Tree_Processing_Data)
is
+ Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
+
Languages : Variable_Value := Nil_Variable_Value;
Def_Lang : Variable_Value := Nil_Variable_Value;
Def_Lang_Id : Name_Id;
@@ -4354,10 +4368,10 @@ package body Prj.Nmsc is
begin
Project.Languages := null;
Languages :=
- Prj.Util.Value_Of (Name_Languages, Project.Decl.Attributes, Data.Tree);
+ Prj.Util.Value_Of (Name_Languages, Project.Decl.Attributes, Shared);
Def_Lang :=
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
@@ -4411,7 +4425,7 @@ package body Prj.Nmsc is
-- Languages.
while Current /= Nil_String loop
- Element := Data.Tree.String_Elements.Table (Current);
+ Element := Shared.String_Elements.Table (Current);
Get_Name_String (Element.Value);
To_Lower (Name_Buffer (1 .. Name_Len));
@@ -4435,41 +4449,43 @@ package body Prj.Nmsc is
(Project : Project_Id;
Data : in out Tree_Processing_Data)
is
+ Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
+
Lib_Interfaces : constant Prj.Variable_Value :=
Prj.Util.Value_Of
(Snames.Name_Library_Interface,
Project.Decl.Attributes,
- Data.Tree);
+ Shared);
Lib_Auto_Init : constant Prj.Variable_Value :=
Prj.Util.Value_Of
(Snames.Name_Library_Auto_Init,
Project.Decl.Attributes,
- Data.Tree);
+ Shared);
Lib_Src_Dir : constant Prj.Variable_Value :=
Prj.Util.Value_Of
(Snames.Name_Library_Src_Dir,
Project.Decl.Attributes,
- Data.Tree);
+ Shared);
Lib_Symbol_File : constant Prj.Variable_Value :=
Prj.Util.Value_Of
(Snames.Name_Library_Symbol_File,
Project.Decl.Attributes,
- Data.Tree);
+ Shared);
Lib_Symbol_Policy : constant Prj.Variable_Value :=
Prj.Util.Value_Of
(Snames.Name_Library_Symbol_Policy,
Project.Decl.Attributes,
- Data.Tree);
+ Shared);
Lib_Ref_Symbol_File : constant Prj.Variable_Value :=
Prj.Util.Value_Of
(Snames.Name_Library_Reference_Symbol_File,
Project.Decl.Attributes,
- Data.Tree);
+ Shared);
Auto_Init_Supported : Boolean;
OK : Boolean := True;
@@ -4508,14 +4524,14 @@ package body Prj.Nmsc is
while Interfaces /= Nil_String loop
Get_Name_String
- (Data.Tree.String_Elements.Table (Interfaces).Value);
+ (Shared.String_Elements.Table (Interfaces).Value);
To_Lower (Name_Buffer (1 .. Name_Len));
if Name_Len = 0 then
Error_Msg
(Data.Flags,
"an interface cannot be an empty string",
- Data.Tree.String_Elements.Table (Interfaces).Location,
+ Shared.String_Elements.Table (Interfaces).Location,
Project);
else
@@ -4564,8 +4580,8 @@ package body Prj.Nmsc is
Error_Msg
(Data.Flags,
"%% is not a unit of this project",
- Data.Tree.String_Elements.Table
- (Interfaces).Location, Project);
+ Shared.String_Elements.Table (Interfaces).Location,
+ Project);
else
if Source.Kind = Spec
@@ -4575,27 +4591,24 @@ package body Prj.Nmsc is
end if;
String_Element_Table.Increment_Last
- (Data.Tree.String_Elements);
+ (Shared.String_Elements);
- Data.Tree.String_Elements.Table
- (String_Element_Table.Last
- (Data.Tree.String_Elements)) :=
+ Shared.String_Elements.Table
+ (String_Element_Table.Last (Shared.String_Elements)) :=
(Value => Name_Id (Source.Dep_Name),
Index => 0,
Display_Value => Name_Id (Source.Dep_Name),
Location =>
- Data.Tree.String_Elements.Table
- (Interfaces).Location,
+ Shared.String_Elements.Table (Interfaces).Location,
Flag => False,
Next => Interface_ALIs);
Interface_ALIs :=
- String_Element_Table.Last
- (Data.Tree.String_Elements);
+ String_Element_Table.Last (Shared.String_Elements);
end if;
end if;
- Interfaces := Data.Tree.String_Elements.Table (Interfaces).Next;
+ Interfaces := Shared.String_Elements.Table (Interfaces).Next;
end loop;
-- Put the list of Interface ALIs in the project data
@@ -4703,7 +4716,7 @@ package body Prj.Nmsc is
Src_Dirs := Project.Source_Dirs;
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
@@ -4734,7 +4747,7 @@ package body Prj.Nmsc is
Src_Dirs := Pid.Project.Source_Dirs;
Dir_Loop : while Src_Dirs /= Nil_String loop
Src_Dir :=
- Data.Tree.String_Elements.Table (Src_Dirs);
+ Shared.String_Elements.Table (Src_Dirs);
-- Report error if it is one of the source
-- directories.
@@ -5002,41 +5015,43 @@ package body Prj.Nmsc is
(Project : Project_Id;
Data : in out Tree_Processing_Data)
is
+ Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
+
Object_Dir : constant Variable_Value :=
Util.Value_Of
- (Name_Object_Dir, Project.Decl.Attributes, Data.Tree);
+ (Name_Object_Dir, Project.Decl.Attributes, Shared);
Exec_Dir : constant Variable_Value :=
Util.Value_Of
- (Name_Exec_Dir, Project.Decl.Attributes, Data.Tree);
+ (Name_Exec_Dir, Project.Decl.Attributes, Shared);
Source_Dirs : constant Variable_Value :=
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 :=
Util.Value_Of
(Name_Ignore_Source_Sub_Dirs,
Project.Decl.Attributes,
- Data.Tree);
+ Shared);
Excluded_Source_Dirs : constant Variable_Value :=
Util.Value_Of
(Name_Excluded_Source_Dirs,
Project.Decl.Attributes,
- Data.Tree);
+ Shared);
Source_Files : constant Variable_Value :=
Util.Value_Of
(Name_Source_Files,
- Project.Decl.Attributes, Data.Tree);
+ Project.Decl.Attributes, Shared);
Last_Source_Dir : String_List_Id := Nil_String;
Last_Src_Dir_Rank : Number_List_Index := No_Number_List;
Languages : constant Variable_Value :=
Prj.Util.Value_Of
- (Name_Languages, Project.Decl.Attributes, Data.Tree);
+ (Name_Languages, Project.Decl.Attributes, Shared);
Remove_Source_Dirs : Boolean := False;
@@ -5070,12 +5085,12 @@ package body Prj.Nmsc is
List := Project.Source_Dirs;
Rank_List := Project.Source_Dir_Ranks;
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);
Prev := List;
List := Element.Next;
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;
-- The directory is in the list if List is not Nil_String
@@ -5083,7 +5098,7 @@ package body Prj.Nmsc is
if not Remove_Source_Dirs and then List = Nil_String then
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 :=
(Value => Name_Id (Path.Name),
Index => 0,
@@ -5092,35 +5107,34 @@ package body Prj.Nmsc is
Flag => False,
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
-- This is the first source directory
Project.Source_Dirs :=
- String_Element_Table.Last (Data.Tree.String_Elements);
+ String_Element_Table.Last (Shared.String_Elements);
Project.Source_Dir_Ranks :=
- Number_List_Table.Last (Data.Tree.Number_Lists);
+ Number_List_Table.Last (Shared.Number_Lists);
else
-- We already have source directories, link the previous
-- last to the new one.
- Data.Tree.String_Elements.Table (Last_Source_Dir).Next :=
- String_Element_Table.Last (Data.Tree.String_Elements);
- Data.Tree.Number_Lists.Table (Last_Src_Dir_Rank).Next :=
- Number_List_Table.Last (Data.Tree.Number_Lists);
+ Shared.String_Elements.Table (Last_Source_Dir).Next :=
+ String_Element_Table.Last (Shared.String_Elements);
+ Shared.Number_Lists.Table (Last_Src_Dir_Rank).Next :=
+ Number_List_Table.Last (Shared.Number_Lists);
end if;
-- And register this source directory as the new last
Last_Source_Dir :=
- String_Element_Table.Last (Data.Tree.String_Elements);
- Data.Tree.String_Elements.Table (Last_Source_Dir) := Element;
- Last_Src_Dir_Rank :=
- Number_List_Table.Last (Data.Tree.Number_Lists);
- Data.Tree.Number_Lists.Table (Last_Src_Dir_Rank) :=
+ String_Element_Table.Last (Shared.String_Elements);
+ Shared.String_Elements.Table (Last_Source_Dir) := Element;
+ Last_Src_Dir_Rank := Number_List_Table.Last (Shared.Number_Lists);
+ Shared.Number_Lists.Table (Last_Src_Dir_Rank) :=
(Number => Rank, Next => No_Number_List);
elsif Remove_Source_Dirs and then List /= Nil_String then
@@ -5128,16 +5142,15 @@ package body Prj.Nmsc is
-- Remove source dir if present
if Prev = Nil_String then
- Project.Source_Dirs :=
- Data.Tree.String_Elements.Table (List).Next;
+ Project.Source_Dirs := Shared.String_Elements.Table (List).Next;
Project.Source_Dir_Ranks :=
- Data.Tree.Number_Lists.Table (Rank_List).Next;
+ Shared.Number_Lists.Table (Rank_List).Next;
else
- Data.Tree.String_Elements.Table (Prev).Next :=
- Data.Tree.String_Elements.Table (List).Next;
- Data.Tree.Number_Lists.Table (Prev_Rank).Next :=
- Data.Tree.Number_Lists.Table (Rank_List).Next;
+ Shared.String_Elements.Table (Prev).Next :=
+ Shared.String_Elements.Table (List).Next;
+ Shared.Number_Lists.Table (Prev_Rank).Next :=
+ Shared.Number_Lists.Table (Rank_List).Next;
end if;
end if;
end Add_To_Or_Remove_From_Source_Dirs;
@@ -5357,11 +5370,11 @@ package body Prj.Nmsc is
begin
while Current /= Nil_String loop
- Element := Data.Tree.String_Elements.Table (Current);
+ Element := Shared.String_Elements.Table (Current);
if Element.Value /= No_Name then
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;
Current := Element.Next;
@@ -5377,9 +5390,11 @@ package body Prj.Nmsc is
(Project : Project_Id;
Data : in out Tree_Processing_Data)
is
+ Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
+
Mains : constant Variable_Value :=
Prj.Util.Value_Of
- (Name_Main, Project.Decl.Attributes, Data.Tree);
+ (Name_Main, Project.Decl.Attributes, Shared);
List : String_List_Id;
Elem : String_Element;
@@ -5405,7 +5420,7 @@ package body Prj.Nmsc is
else
List := Mains.Values;
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
Error_Msg
@@ -5972,15 +5987,17 @@ package body Prj.Nmsc is
(Project : in out Project_Processing_Data;
Data : in out Tree_Processing_Data)
is
+ Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
+
Excluded_Source_List_File : constant Variable_Value :=
Util.Value_Of
(Name_Excluded_Source_List_File,
Project.Project.Decl.Attributes,
- Data.Tree);
+ Shared);
Excluded_Sources : Variable_Value := Util.Value_Of
(Name_Excluded_Source_Files,
Project.Project.Decl.Attributes,
- Data.Tree);
+ Shared);
Current : String_List_Id;
Element : String_Element;
@@ -5999,7 +6016,7 @@ package body Prj.Nmsc is
Excluded_Sources :=
Util.Value_Of
(Name_Locally_Removed_Files,
- Project.Project.Decl.Attributes, Data.Tree);
+ Project.Project.Decl.Attributes, Shared);
end if;
-- If there are excluded sources, put them in the table
@@ -6023,7 +6040,7 @@ package body Prj.Nmsc is
Current := Excluded_Sources.Values;
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);
-- If the element has no location, then use the location of
@@ -6129,17 +6146,19 @@ package body Prj.Nmsc is
(Project : in out Project_Processing_Data;
Data : in out Tree_Processing_Data)
is
+ Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
+
Sources : constant Variable_Value :=
Util.Value_Of
(Name_Source_Files,
Project.Project.Decl.Attributes,
- Data.Tree);
+ Shared);
Source_List_File : constant Variable_Value :=
Util.Value_Of
(Name_Source_List_File,
Project.Project.Decl.Attributes,
- Data.Tree);
+ Shared);
Name_Loc : Name_Location;
Has_Explicit_Sources : Boolean;
@@ -6188,7 +6207,7 @@ package body Prj.Nmsc is
end if;
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);
Get_Name_String (Element.Value);
@@ -6810,6 +6829,8 @@ package body Prj.Nmsc is
Search_For : Search_Type;
Resolve_Links : Boolean)
is
+ Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
+
package Recursive_Dirs is new GNAT.Dynamic_HTables.Simple_HTable
(Header_Num => Header_Num,
Element => Boolean,
@@ -6950,13 +6971,12 @@ package body Prj.Nmsc is
while List /= Nil_String loop
Get_Name_String
- (Data.Tree.String_Elements.Table (List).Value);
+ (Shared.String_Elements.Table (List).Value);
Canonical_Case_File_Name
(Name_Buffer (1 .. Name_Len));
OK := Name_Buffer (1 .. Name_Len) /= Dir_Name;
exit when not OK;
- List :=
- Data.Tree.String_Elements.Table (List).Next;
+ List := Shared.String_Elements.Table (List).Next;
end loop;
end;
end if;
@@ -7116,7 +7136,7 @@ package body Prj.Nmsc is
begin
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);
Rank := Rank + 1;
Pattern_Id := Element.Next;
@@ -7134,6 +7154,8 @@ package body Prj.Nmsc is
Data : in out Tree_Processing_Data;
For_All_Sources : Boolean)
is
+ Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
+
Source_Dir : String_List_Id;
Element : String_Element;
Src_Dir_Rank : Number_List_Index;
@@ -7153,8 +7175,8 @@ package body Prj.Nmsc is
Src_Dir_Rank := Project.Project.Source_Dir_Ranks;
while Source_Dir /= Nil_String loop
begin
- Num_Nod := Data.Tree.Number_Lists.Table (Src_Dir_Rank);
- Element := Data.Tree.String_Elements.Table (Source_Dir);
+ Num_Nod := Shared.Number_Lists.Table (Src_Dir_Rank);
+ Element := Shared.String_Elements.Table (Source_Dir);
-- Use Element.Value in this test, not Display_Value, because we
-- want the symbolic links to be resolved when appropriate.
@@ -7932,7 +7954,7 @@ package body Prj.Nmsc is
procedure Show_Source_Dirs
(Project : Project_Id;
- In_Tree : Project_Tree_Ref)
+ Shared : Shared_Project_Tree_Data_Access)
is
Current : String_List_Id;
Element : String_Element;
@@ -7945,7 +7967,7 @@ package body Prj.Nmsc is
Current := Project.Source_Dirs;
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));
Current := Element.Next;
end loop;
@@ -7965,8 +7987,9 @@ package body Prj.Nmsc is
Flags : Processing_Flags)
is
procedure Recursive_Check
- (Project : Project_Id;
- Data : in out Tree_Processing_Data);
+ (Project : Project_Id;
+ Prj_Tree : Project_Tree_Ref;
+ Data : in out Tree_Processing_Data);
-- Check_Naming_Scheme for the project
---------------------
@@ -7974,17 +7997,21 @@ package body Prj.Nmsc is
---------------------
procedure Recursive_Check
- (Project : Project_Id;
- Data : in out Tree_Processing_Data)
- is
+ (Project : Project_Id;
+ Prj_Tree : Project_Tree_Ref;
+ Data : in out Tree_Processing_Data) is
begin
- if Verbose_Mode then
- Write_Str ("Processing_Naming_Scheme for project """);
- Write_Str (Get_Name_String (Project.Name));
- Write_Line ("""");
+ if Current_Verbosity = High then
+ Debug_Increase_Indent
+ ("Processing_Naming_Scheme for project", Project.Name);
end if;
+ Data.Tree := Prj_Tree;
Prj.Nmsc.Check (Project, Data);
+
+ if Current_Verbosity = High then
+ Debug_Decrease_Indent ("Done Processing_Naming_Scheme");
+ end if;
end Recursive_Check;
procedure Check_All_Projects is new
@@ -7996,7 +8023,7 @@ package body Prj.Nmsc is
begin
Lib_Data_Table.Init;
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);
-- Adjust language configs for projects that are extended
diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb
index ac07421eb90..15491996cad 100644
--- a/gcc/ada/prj-proc.adb
+++ b/gcc/ada/prj-proc.adb
@@ -71,7 +71,7 @@ package body Prj.Proc is
(Project : Project_Id;
Project_Name : Name_Id;
Project_Dir : Name_Id;
- In_Tree : Project_Tree_Ref;
+ Shared : Shared_Project_Tree_Data_Access;
Decl : in out Declarations;
First : Attribute_Node_Id;
Project_Level : Boolean);
@@ -95,7 +95,7 @@ package body Prj.Proc is
To : in out Declarations;
New_Loc : Source_Ptr;
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
-- locations of all the attributes to New_Loc. When Restricted is
-- True, do not copy attributes Body, Spec, Implementation, Specification
@@ -103,7 +103,7 @@ package body Prj.Proc is
function Expression
(Project : Project_Id;
- In_Tree : Project_Tree_Ref;
+ Shared : Shared_Project_Tree_Data_Access;
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
Env : Prj.Tree.Environment;
@@ -120,29 +120,26 @@ package body Prj.Proc is
function Package_From
(Project : Project_Id;
- In_Tree : Project_Tree_Ref;
+ Shared : Shared_Project_Tree_Data_Access;
With_Name : Name_Id) return Package_Id;
-- Find the package of Project whose name is With_Name
procedure Process_Declarative_Items
- (Project : Project_Id;
- In_Tree : Project_Tree_Ref;
- From_Project_Node : Project_Node_Id;
- Node_Tree : Project_Node_Tree_Ref;
- Env : Prj.Tree.Environment;
- Pkg : Package_Id;
- Item : Project_Node_Id;
- Child_Env : in out Prj.Tree.Environment;
- Can_Modify_Child_Env : Boolean);
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ From_Project_Node : Project_Node_Id;
+ Node_Tree : Project_Node_Tree_Ref;
+ Env : Prj.Tree.Environment;
+ Pkg : Package_Id;
+ Item : Project_Node_Id;
+ Child_Env : in out Prj.Tree.Environment);
-- Process declarative items starting with From_Project_Node, and put them
-- in declarations Decl. This is a recursive procedure; it calls itself for
-- a package declaration or a case construction.
--
-- Child_Env is the modified environment after seeing declarations like
-- "for External(...) use" or "for Project_Path use" in aggregate projects.
- -- It should have been initialized first. This environment can only be
- -- modified if Can_Modify_Child_Env is True, otherwise all the above
- -- attributes simply have no effect.
+ -- It should have been initialized first.
procedure Recursive_Process
(In_Tree : Project_Tree_Ref;
@@ -150,20 +147,13 @@ package body Prj.Proc is
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
Env : in out Prj.Tree.Environment;
- Extended_By : Project_Id;
- Child_Env : in out Prj.Tree.Environment;
- Is_Root_Project : Boolean);
+ Extended_By : Project_Id);
-- 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,
-- simply return its project id. Otherwise create a new project id, mark it
-- as processed, call itself recursively for all imported projects and a
-- extended project, if any. Then process the declarative items of the
-- 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
-- explicitly loaded. In the context of aggregate projects, only that
-- project is allowed to modify the environment that will be used to load
@@ -209,7 +199,7 @@ package body Prj.Proc is
(Project : Project_Id;
Project_Name : Name_Id;
Project_Dir : Name_Id;
- In_Tree : Project_Tree_Ref;
+ Shared : Shared_Project_Tree_Data_Access;
Decl : in out Declarations;
First : Attribute_Node_Id;
Project_Level : Boolean)
@@ -272,15 +262,14 @@ package body Prj.Proc is
end case;
Variable_Element_Table.Increment_Last
- (In_Tree.Variable_Elements);
- In_Tree.Variable_Elements.Table
- (Variable_Element_Table.Last
- (In_Tree.Variable_Elements)) :=
+ (Shared.Variable_Elements);
+ Shared.Variable_Elements.Table
+ (Variable_Element_Table.Last (Shared.Variable_Elements)) :=
(Next => Decl.Attributes,
Name => Attribute_Name_Of (The_Attribute),
Value => New_Attribute);
Decl.Attributes := Variable_Element_Table.Last
- (In_Tree.Variable_Elements);
+ (Shared.Variable_Elements);
end;
end if;
@@ -342,7 +331,7 @@ package body Prj.Proc is
To : in out Declarations;
New_Loc : Source_Ptr;
Restricted : Boolean;
- In_Tree : Project_Tree_Ref)
+ Shared : Shared_Project_Tree_Data_Access)
is
V1 : Variable_Id;
V2 : Variable_Id := No_Variable;
@@ -367,7 +356,7 @@ package body Prj.Proc is
-- Copy the attribute
- Var := In_Tree.Variable_Elements.Table (V1);
+ Var := Shared.Variable_Elements.Table (V1);
V1 := Var.Next;
-- Do not copy the value of attribute Linker_Options if Restricted
@@ -383,27 +372,27 @@ package body Prj.Proc is
-- Change the location to 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
if To.Attributes = No_Variable then
To.Attributes :=
- Variable_Element_Table.Last (In_Tree.Variable_Elements);
+ Variable_Element_Table.Last (Shared.Variable_Elements);
else
- In_Tree.Variable_Elements.Table (V2).Next :=
- Variable_Element_Table.Last (In_Tree.Variable_Elements);
+ Shared.Variable_Elements.Table (V2).Next :=
+ Variable_Element_Table.Last (Shared.Variable_Elements);
end if;
- V2 := Variable_Element_Table.Last (In_Tree.Variable_Elements);
- In_Tree.Variable_Elements.Table (V2) := Var;
+ V2 := Variable_Element_Table.Last (Shared.Variable_Elements);
+ Shared.Variable_Elements.Table (V2) := Var;
end loop;
-- Then the associated array attributes
A1 := From.Arrays;
while A1 /= No_Array loop
- Arr := In_Tree.Arrays.Table (A1);
+ Arr := Shared.Arrays.Table (A1);
A1 := Arr.Next;
if not Restricted
@@ -416,18 +405,18 @@ package body Prj.Proc is
-- Remove the Next component
Arr.Next := No_Array;
- Array_Table.Increment_Last (In_Tree.Arrays);
+ Array_Table.Increment_Last (Shared.Arrays);
-- Create new Array declaration
if To.Arrays = No_Array then
- To.Arrays := Array_Table.Last (In_Tree.Arrays);
+ To.Arrays := Array_Table.Last (Shared.Arrays);
else
- In_Tree.Arrays.Table (A2).Next :=
- Array_Table.Last (In_Tree.Arrays);
+ Shared.Arrays.Table (A2).Next :=
+ Array_Table.Last (Shared.Arrays);
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
@@ -439,7 +428,7 @@ package body Prj.Proc is
-- Copy the array element
- Elm := In_Tree.Array_Elements.Table (E1);
+ Elm := Shared.Array_Elements.Table (E1);
E1 := Elm.Next;
-- Remove the Next component
@@ -449,25 +438,25 @@ package body Prj.Proc is
-- Change the location
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
if Arr.Value = No_Array_Element then
Arr.Value :=
- Array_Element_Table.Last (In_Tree.Array_Elements);
+ Array_Element_Table.Last (Shared.Array_Elements);
else
- In_Tree.Array_Elements.Table (E2).Next :=
- Array_Element_Table.Last (In_Tree.Array_Elements);
+ Shared.Array_Elements.Table (E2).Next :=
+ Array_Element_Table.Last (Shared.Array_Elements);
end if;
- E2 := Array_Element_Table.Last (In_Tree.Array_Elements);
- In_Tree.Array_Elements.Table (E2) := Elm;
+ E2 := Array_Element_Table.Last (Shared.Array_Elements);
+ Shared.Array_Elements.Table (E2) := Elm;
end loop;
-- Finally, store the new array
- In_Tree.Arrays.Table (A2) := Arr;
+ Shared.Arrays.Table (A2) := Arr;
end if;
end loop;
end Copy_Package_Declarations;
@@ -499,7 +488,7 @@ package body Prj.Proc is
function Expression
(Project : Project_Id;
- In_Tree : Project_Tree_Ref;
+ Shared : Shared_Project_Tree_Data_Access;
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
Env : Prj.Tree.Environment;
@@ -553,25 +542,25 @@ package body Prj.Proc is
when List =>
String_Element_Table.Increment_Last
- (In_Tree.String_Elements);
+ (Shared.String_Elements);
if Last = Nil_String then
-- This can happen in an expression like () & "toto"
Result.Values := String_Element_Table.Last
- (In_Tree.String_Elements);
+ (Shared.String_Elements);
else
- In_Tree.String_Elements.Table
+ Shared.String_Elements.Table
(Last).Next := String_Element_Table.Last
- (In_Tree.String_Elements);
+ (Shared.String_Elements);
end if;
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
(The_Current_Term,
From_Project_Node_Tree),
@@ -604,7 +593,7 @@ package body Prj.Proc is
Value := Expression
(Project => Project,
- In_Tree => In_Tree,
+ Shared => Shared,
From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree,
Env => Env,
@@ -614,26 +603,25 @@ package body Prj.Proc is
(String_Node, From_Project_Node_Tree),
Kind => Single);
String_Element_Table.Increment_Last
- (In_Tree.String_Elements);
+ (Shared.String_Elements);
if Result.Values = Nil_String then
-- This literal string list is the first term in a
-- string list expression
- Result.Values :=
- String_Element_Table.Last (In_Tree.String_Elements);
+ Result.Values := String_Element_Table.Last
+ (Shared.String_Elements);
else
- In_Tree.String_Elements.Table
- (Last).Next :=
- String_Element_Table.Last (In_Tree.String_Elements);
+ Shared.String_Elements.Table (Last).Next :=
+ String_Element_Table.Last (Shared.String_Elements);
end if;
- Last :=
- String_Element_Table.Last (In_Tree.String_Elements);
+ Last := String_Element_Table.Last
+ (Shared.String_Elements);
- In_Tree.String_Elements.Table (Last) :=
+ Shared.String_Elements.Table (Last) :=
(Value => Value.Value,
Display_Value => No_Name,
Location => Value.Location,
@@ -654,7 +642,7 @@ package body Prj.Proc is
Value :=
Expression
(Project => Project,
- In_Tree => In_Tree,
+ Shared => Shared,
From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree,
Env => Env,
@@ -665,12 +653,12 @@ package body Prj.Proc is
Kind => Single);
String_Element_Table.Increment_Last
- (In_Tree.String_Elements);
- In_Tree.String_Elements.Table (Last).Next :=
- String_Element_Table.Last (In_Tree.String_Elements);
- Last :=
- String_Element_Table.Last (In_Tree.String_Elements);
- In_Tree.String_Elements.Table (Last) :=
+ (Shared.String_Elements);
+ Shared.String_Elements.Table (Last).Next :=
+ String_Element_Table.Last (Shared.String_Elements);
+ Last := String_Element_Table.Last
+ (Shared.String_Elements);
+ Shared.String_Elements.Table (Last) :=
(Value => Value.Value,
Display_Value => No_Name,
Location => Value.Location,
@@ -721,11 +709,11 @@ package body Prj.Proc is
The_Package := The_Project.Decl.Packages;
while The_Package /= No_Package
- and then In_Tree.Packages.Table
- (The_Package).Name /= The_Name
+ and then Shared.Packages.Table (The_Package).Name /=
+ The_Name
loop
The_Package :=
- In_Tree.Packages.Table (The_Package).Next;
+ Shared.Packages.Table (The_Package).Next;
end loop;
pragma Assert
@@ -762,22 +750,20 @@ package body Prj.Proc is
N_Variable_Reference
then
The_Variable_Id :=
- In_Tree.Packages.Table
+ Shared.Packages.Table
(The_Package).Decl.Variables;
else
The_Variable_Id :=
- In_Tree.Packages.Table
+ Shared.Packages.Table
(The_Package).Decl.Attributes;
end if;
while The_Variable_Id /= No_Variable
- and then
- In_Tree.Variable_Elements.Table
- (The_Variable_Id).Name /= The_Name
+ and then Shared.Variable_Elements.Table
+ (The_Variable_Id).Name /= The_Name
loop
- The_Variable_Id :=
- In_Tree.Variable_Elements.Table
- (The_Variable_Id).Next;
+ The_Variable_Id := Shared.Variable_Elements.Table
+ (The_Variable_Id).Next;
end loop;
end if;
@@ -795,12 +781,11 @@ package body Prj.Proc is
end if;
while The_Variable_Id /= No_Variable
- and then
- In_Tree.Variable_Elements.Table
+ and then Shared.Variable_Elements.Table
(The_Variable_Id).Name /= The_Name
loop
The_Variable_Id :=
- In_Tree.Variable_Elements.Table
+ Shared.Variable_Elements.Table
(The_Variable_Id).Next;
end loop;
@@ -810,8 +795,7 @@ package body Prj.Proc is
"variable or attribute not found");
The_Variable :=
- In_Tree.Variable_Elements.Table
- (The_Variable_Id).Value;
+ Shared.Variable_Elements.Table (The_Variable_Id).Value;
else
@@ -824,22 +808,22 @@ package body Prj.Proc is
begin
if The_Package /= No_Package then
- The_Array :=
- In_Tree.Packages.Table (The_Package).Decl.Arrays;
+ The_Array := Shared.Packages.Table
+ (The_Package).Decl.Arrays;
else
The_Array := The_Project.Decl.Arrays;
end if;
while The_Array /= No_Array
- and then In_Tree.Arrays.Table
- (The_Array).Name /= The_Name
+ and then Shared.Arrays.Table (The_Array).Name /=
+ The_Name
loop
- The_Array := In_Tree.Arrays.Table (The_Array).Next;
+ The_Array := Shared.Arrays.Table (The_Array).Next;
end loop;
if The_Array /= No_Array then
The_Element :=
- In_Tree.Arrays.Table (The_Array).Value;
+ Shared.Arrays.Table (The_Array).Value;
Array_Index :=
Get_Attribute_Index
(From_Project_Node_Tree,
@@ -847,19 +831,19 @@ package body Prj.Proc is
Index);
while The_Element /= No_Array_Element
- and then In_Tree.Array_Elements.Table
+ and then Shared.Array_Elements.Table
(The_Element).Index /= Array_Index
loop
The_Element :=
- In_Tree.Array_Elements.Table
+ Shared.Array_Elements.Table
(The_Element).Next;
end loop;
end if;
if The_Element /= No_Array_Element then
- The_Variable :=
- In_Tree.Array_Elements.Table (The_Element).Value;
+ The_Variable := Shared.Array_Elements.Table
+ (The_Element).Value;
else
if Expression_Kind_Of
@@ -923,7 +907,7 @@ package body Prj.Proc is
when Single =>
String_Element_Table.Increment_Last
- (In_Tree.String_Elements);
+ (Shared.String_Elements);
if Last = Nil_String then
@@ -932,20 +916,19 @@ package body Prj.Proc is
Result.Values :=
String_Element_Table.Last
- (In_Tree.String_Elements);
+ (Shared.String_Elements);
else
- In_Tree.String_Elements.Table
- (Last).Next :=
+ Shared.String_Elements.Table (Last).Next :=
String_Element_Table.Last
- (In_Tree.String_Elements);
+ (Shared.String_Elements);
end if;
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,
Display_Value => No_Name,
Location => Location_Of
@@ -964,30 +947,29 @@ package body Prj.Proc is
begin
while The_List /= Nil_String loop
String_Element_Table.Increment_Last
- (In_Tree.String_Elements);
+ (Shared.String_Elements);
if Last = Nil_String then
Result.Values :=
String_Element_Table.Last
- (In_Tree.
- String_Elements);
+ (Shared.String_Elements);
else
- In_Tree.
+ Shared.
String_Elements.Table (Last).Next :=
String_Element_Table.Last
- (In_Tree.
- String_Elements);
+ (Shared.String_Elements);
end if;
Last :=
String_Element_Table.Last
- (In_Tree.String_Elements);
+ (Shared.String_Elements);
- In_Tree.String_Elements.Table (Last) :=
+ Shared.String_Elements.Table
+ (Last) :=
(Value =>
- In_Tree.String_Elements.Table
+ Shared.String_Elements.Table
(The_List).Value,
Display_Value => No_Name,
Location =>
@@ -998,8 +980,7 @@ package body Prj.Proc is
Next => Nil_String,
Index => 0);
- The_List :=
- In_Tree. String_Elements.Table
+ The_List := Shared.String_Elements.Table
(The_List).Next;
end loop;
end;
@@ -1034,7 +1015,7 @@ package body Prj.Proc is
if Present (Default_Node) then
Def_Var := Expression
(Project => Project,
- In_Tree => In_Tree,
+ Shared => Shared,
From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree,
Env => Env,
@@ -1189,29 +1170,28 @@ package body Prj.Proc is
when List =>
if not Ext_List or else Str_List /= null then
String_Element_Table.Increment_Last
- (In_Tree.String_Elements);
+ (Shared.String_Elements);
if Last = Nil_String then
Result.Values :=
String_Element_Table.Last
- (In_Tree.String_Elements);
+ (Shared.String_Elements);
else
- In_Tree.String_Elements.Table (Last).Next :=
- String_Element_Table.Last
- (In_Tree.String_Elements);
+ Shared.String_Elements.Table (Last).Next
+ := String_Element_Table.Last
+ (Shared.String_Elements);
end if;
- Last :=
- String_Element_Table.Last
- (In_Tree.String_Elements);
+ Last := String_Element_Table.Last
+ (Shared.String_Elements);
if Ext_List then
for Ind in Str_List'Range loop
Name_Len := 0;
Add_Str_To_Name_Buffer (Str_List (Ind).all);
Value := Name_Find;
- In_Tree.String_Elements.Table (Last) :=
+ Shared.String_Elements.Table (Last) :=
(Value => Value,
Display_Value => No_Name,
Location =>
@@ -1224,19 +1204,17 @@ package body Prj.Proc is
if Ind /= Str_List'Last then
String_Element_Table.Increment_Last
- (In_Tree.String_Elements);
- In_Tree.String_Elements.Table
- (Last).Next :=
+ (Shared.String_Elements);
+ Shared.String_Elements.Table (Last).Next :=
String_Element_Table.Last
- (In_Tree.String_Elements);
- Last :=
- String_Element_Table.Last
- (In_Tree.String_Elements);
+ (Shared.String_Elements);
+ Last := String_Element_Table.Last
+ (Shared.String_Elements);
end if;
end loop;
else
- In_Tree.String_Elements.Table (Last) :=
+ Shared.String_Elements.Table (Last) :=
(Value => Value,
Display_Value => No_Name,
Location =>
@@ -1337,7 +1315,7 @@ package body Prj.Proc is
function Package_From
(Project : Project_Id;
- In_Tree : Project_Tree_Ref;
+ Shared : Shared_Project_Tree_Data_Access;
With_Name : Name_Id) return Package_Id
is
Result : Package_Id := Project.Decl.Packages;
@@ -1346,9 +1324,9 @@ package body Prj.Proc is
-- Check the name of each existing package of Project
while Result /= No_Package
- and then In_Tree.Packages.Table (Result).Name /= With_Name
+ and then Shared.Packages.Table (Result).Name /= With_Name
loop
- Result := In_Tree.Packages.Table (Result).Next;
+ Result := Shared.Packages.Table (Result).Next;
end loop;
if Result = No_Package then
@@ -1412,9 +1390,11 @@ package body Prj.Proc is
Env : Prj.Tree.Environment;
Pkg : Package_Id;
Item : Project_Node_Id;
- Child_Env : in out Prj.Tree.Environment;
- Can_Modify_Child_Env : Boolean)
+ Child_Env : in out Prj.Tree.Environment)
is
+ Shared : constant Shared_Project_Tree_Data_Access :=
+ In_Tree.Shared;
+
procedure Check_Or_Set_Typed_Variable
(Value : in out Variable_Value;
Declaration : Project_Node_Id);
@@ -1532,11 +1512,11 @@ package body Prj.Proc is
-- Create the new package
- Package_Table.Increment_Last (In_Tree.Packages);
+ Package_Table.Increment_Last (Shared.Packages);
declare
New_Pkg : constant Package_Id :=
- Package_Table.Last (In_Tree.Packages);
+ Package_Table.Last (Shared.Packages);
The_New_Package : Package_Element;
Project_Of_Renamed_Package : constant Project_Node_Id :=
@@ -1552,15 +1532,15 @@ package body Prj.Proc is
if Pkg /= No_Package then
The_New_Package.Next :=
- In_Tree.Packages.Table (Pkg).Decl.Packages;
- In_Tree.Packages.Table (Pkg).Decl.Packages := New_Pkg;
+ Shared.Packages.Table (Pkg).Decl.Packages;
+ Shared.Packages.Table (Pkg).Decl.Packages := New_Pkg;
else
The_New_Package.Next := Project.Decl.Packages;
Project.Decl.Packages := New_Pkg;
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
@@ -1576,7 +1556,7 @@ package body Prj.Proc is
Renamed_Package : constant Package_Id :=
Package_From
- (Renamed_Project, In_Tree,
+ (Renamed_Project, Shared,
Name_Of (Current_Item, Node_Tree));
begin
@@ -1586,11 +1566,11 @@ package body Prj.Proc is
-- declaration.
Copy_Package_Declarations
- (From => In_Tree.Packages.Table (Renamed_Package).Decl,
- To => In_Tree.Packages.Table (New_Pkg).Decl,
+ (From => Shared.Packages.Table (Renamed_Package).Decl,
+ To => Shared.Packages.Table (New_Pkg).Decl,
New_Loc => Location_Of (Current_Item, Node_Tree),
Restricted => False,
- In_Tree => In_Tree);
+ Shared => Shared);
end;
else
@@ -1600,8 +1580,8 @@ package body Prj.Proc is
(Project,
Project.Name,
Name_Id (Project.Directory.Name),
- In_Tree,
- In_Tree.Packages.Table (New_Pkg).Decl,
+ Shared,
+ Shared.Packages.Table (New_Pkg).Decl,
First_Attribute_Of
(Package_Id_Of (Current_Item, Node_Tree)),
Project_Level => False);
@@ -1619,8 +1599,7 @@ package body Prj.Proc is
Pkg => New_Pkg,
Item =>
First_Declarative_Item_Of (Current_Item, Node_Tree),
- Child_Env => Child_Env,
- Can_Modify_Child_Env => Can_Modify_Child_Env);
+ Child_Env => Child_Env);
end;
end if;
end Process_Package_Declaration;
@@ -1683,35 +1662,35 @@ package body Prj.Proc is
-- declared.
if Pkg /= No_Package then
- New_Array := In_Tree.Packages.Table (Pkg).Decl.Arrays;
+ New_Array := Shared.Packages.Table (Pkg).Decl.Arrays;
else
New_Array := Project.Decl.Arrays;
end if;
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
- New_Array := In_Tree.Arrays.Table (New_Array).Next;
+ New_Array := Shared.Arrays.Table (New_Array).Next;
end loop;
-- If the attribute has never been declared add new entry in the
-- arrays of the project/package and link it.
if New_Array = No_Array then
- Array_Table.Increment_Last (In_Tree.Arrays);
- New_Array := Array_Table.Last (In_Tree.Arrays);
+ Array_Table.Increment_Last (Shared.Arrays);
+ New_Array := Array_Table.Last (Shared.Arrays);
if Pkg /= No_Package then
- In_Tree.Arrays.Table (New_Array) :=
+ Shared.Arrays.Table (New_Array) :=
(Name => Current_Item_Name,
Location => Current_Location,
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
- In_Tree.Arrays.Table (New_Array) :=
+ Shared.Arrays.Table (New_Array) :=
(Name => Current_Item_Name,
Location => Current_Location,
Value => No_Array_Element,
@@ -1753,23 +1732,23 @@ package body Prj.Proc is
pragma Assert (Orig_Package /= No_Package,
"original package not found");
- while In_Tree.Packages.Table
- (Orig_Package).Name /= Orig_Package_Name
+ while Shared.Packages.Table
+ (Orig_Package).Name /= Orig_Package_Name
loop
- Orig_Package := In_Tree.Packages.Table (Orig_Package).Next;
+ Orig_Package := Shared.Packages.Table (Orig_Package).Next;
pragma Assert (Orig_Package /= No_Package,
"original package not found");
end loop;
- Orig_Array := In_Tree.Packages.Table (Orig_Package).Decl.Arrays;
+ Orig_Array := Shared.Packages.Table (Orig_Package).Decl.Arrays;
end if;
-- Now look for the 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
- Orig_Array := In_Tree.Arrays.Table (Orig_Array).Next;
+ Orig_Array := Shared.Arrays.Table (Orig_Array).Next;
end loop;
if Orig_Array = No_Array then
@@ -1780,7 +1759,7 @@ package body Prj.Proc is
Project);
else
- Orig_Element := In_Tree.Arrays.Table (Orig_Array).Value;
+ Orig_Element := Shared.Arrays.Table (Orig_Array).Value;
-- Copy each array element
@@ -1793,22 +1772,22 @@ package body Prj.Proc is
-- And there is no array element declared yet, create a new
-- first array element.
- if In_Tree.Arrays.Table (New_Array).Value =
+ if Shared.Arrays.Table (New_Array).Value =
No_Array_Element
then
Array_Element_Table.Increment_Last
- (In_Tree.Array_Elements);
+ (Shared.Array_Elements);
New_Element := Array_Element_Table.Last
- (In_Tree.Array_Elements);
- In_Tree.Arrays.Table (New_Array).Value := New_Element;
+ (Shared.Array_Elements);
+ Shared.Arrays.Table (New_Array).Value := New_Element;
Next_Element := No_Array_Element;
-- Otherwise, the new element is the first
else
- New_Element := In_Tree.Arrays. Table (New_Array).Value;
+ New_Element := Shared.Arrays.Table (New_Array).Value;
Next_Element :=
- In_Tree.Array_Elements.Table (New_Element).Next;
+ Shared.Array_Elements.Table (New_Element).Next;
end if;
-- Otherwise, reuse an existing element, or create
@@ -1816,33 +1795,33 @@ package body Prj.Proc is
else
Next_Element :=
- In_Tree.Array_Elements.Table (Prev_Element).Next;
+ Shared.Array_Elements.Table (Prev_Element).Next;
if Next_Element = No_Array_Element then
Array_Element_Table.Increment_Last
- (In_Tree.Array_Elements);
- New_Element :=
- Array_Element_Table.Last (In_Tree.Array_Elements);
- In_Tree.Array_Elements.Table (Prev_Element).Next :=
+ (Shared.Array_Elements);
+ New_Element := Array_Element_Table.Last
+ (Shared.Array_Elements);
+ Shared.Array_Elements.Table (Prev_Element).Next :=
New_Element;
else
New_Element := Next_Element;
Next_Element :=
- In_Tree.Array_Elements.Table (New_Element).Next;
+ Shared.Array_Elements.Table (New_Element).Next;
end if;
end if;
-- Copy the value of the element
- In_Tree.Array_Elements.Table (New_Element) :=
- In_Tree.Array_Elements.Table (Orig_Element);
- In_Tree.Array_Elements.Table (New_Element).Value.Project :=
- Project;
+ Shared.Array_Elements.Table (New_Element) :=
+ Shared.Array_Elements.Table (Orig_Element);
+ Shared.Array_Elements.Table (New_Element).Value.Project
+ := Project;
-- 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
@@ -1850,15 +1829,13 @@ package body Prj.Proc is
-- Go to the next element in the original array
- Orig_Element :=
- In_Tree.Array_Elements.Table (Orig_Element).Next;
+ Orig_Element := Shared.Array_Elements.Table (Orig_Element).Next;
end loop;
-- Make sure that the array ends here, in case there previously a
-- greater number of elements.
- In_Tree.Array_Elements.Table (New_Element).Next :=
- No_Array_Element;
+ Shared.Array_Elements.Table (New_Element).Next := No_Array_Element;
end if;
end Process_Associative_Array;
@@ -1891,15 +1868,15 @@ package body Prj.Proc is
-- Look for the array in the appropriate list
if Pkg /= No_Package then
- The_Array := In_Tree.Packages.Table (Pkg).Decl.Arrays;
+ The_Array := Shared.Packages.Table (Pkg).Decl.Arrays;
else
The_Array := Project.Decl.Arrays;
end if;
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
- The_Array := In_Tree.Arrays.Table (The_Array).Next;
+ The_Array := Shared.Arrays.Table (The_Array).Next;
end loop;
-- If the array cannot be found, create a new entry in the list.
@@ -1907,20 +1884,20 @@ package body Prj.Proc is
-- element will be created automatically later
if The_Array = No_Array then
- Array_Table.Increment_Last (In_Tree.Arrays);
- The_Array := Array_Table.Last (In_Tree.Arrays);
+ Array_Table.Increment_Last (Shared.Arrays);
+ The_Array := Array_Table.Last (Shared.Arrays);
if Pkg /= No_Package then
- In_Tree.Arrays.Table (The_Array) :=
+ Shared.Arrays.Table (The_Array) :=
(Name => Name,
Location => Current_Location,
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
- In_Tree.Arrays.Table (The_Array) :=
+ Shared.Arrays.Table (The_Array) :=
(Name => Name,
Location => Current_Location,
Value => No_Array_Element,
@@ -1930,7 +1907,7 @@ package body Prj.Proc is
end if;
else
- Elem := In_Tree.Arrays.Table (The_Array).Value;
+ Elem := Shared.Arrays.Table (The_Array).Value;
end if;
-- Look in the list, if any, to find an element with the same index
@@ -1938,11 +1915,11 @@ package body Prj.Proc is
while Elem /= No_Array_Element
and then
- (In_Tree.Array_Elements.Table (Elem).Index /= Index_Name
+ (Shared.Array_Elements.Table (Elem).Index /= Index_Name
or else
- In_Tree.Array_Elements.Table (Elem).Src_Index /= Source_Index)
+ Shared.Array_Elements.Table (Elem).Src_Index /= Source_Index)
loop
- Elem := In_Tree.Array_Elements.Table (Elem).Next;
+ Elem := Shared.Array_Elements.Table (Elem).Next;
end loop;
-- If no such element were found, create a new one
@@ -1950,29 +1927,29 @@ package body Prj.Proc is
-- proper value.
if Elem = No_Array_Element then
- Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
- Elem := Array_Element_Table.Last (In_Tree.Array_Elements);
+ Array_Element_Table.Increment_Last (Shared.Array_Elements);
+ Elem := Array_Element_Table.Last (Shared.Array_Elements);
- In_Tree.Array_Elements.Table
+ Shared.Array_Elements.Table
(Elem) :=
(Index => Index_Name,
Src_Index => Source_Index,
Index_Case_Sensitive =>
not Case_Insensitive (Current, Node_Tree),
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
-- An element with the same index already exists, just replace its
-- value with the new one.
- In_Tree.Array_Elements.Table (Elem).Value := New_Value;
+ Shared.Array_Elements.Table (Elem).Value := New_Value;
end if;
if Name = Snames.Name_External then
- if Can_Modify_Child_Env then
+ if In_Tree.Is_Root_Tree then
Add (Child_Env.External,
External_Name => Get_Name_String (Index_Name),
Value => Get_Name_String (New_Value.Value),
@@ -2015,14 +1992,14 @@ package body Prj.Proc is
if Is_Attribute then
if Pkg /= No_Package then
- Var := In_Tree.Packages.Table (Pkg).Decl.Attributes;
+ Var := Shared.Packages.Table (Pkg).Decl.Attributes;
else
Var := Project.Decl.Attributes;
end if;
else
if Pkg /= No_Package then
- Var := In_Tree.Packages.Table (Pkg).Decl.Variables;
+ Var := Shared.Packages.Table (Pkg).Decl.Variables;
else
Var := Project.Decl.Variables;
end if;
@@ -2031,9 +2008,9 @@ package body Prj.Proc is
-- Loop through the list, to find if it has already been declared.
while Var /= No_Variable
- and then In_Tree.Variable_Elements.Table (Var).Name /= Name
+ and then Shared.Variable_Elements.Table (Var).Name /= Name
loop
- Var := In_Tree.Variable_Elements.Table (Var).Next;
+ Var := Shared.Variable_Elements.Table (Var).Next;
end loop;
-- If it has not been declared, create a new entry in the list
@@ -2047,20 +2024,20 @@ package body Prj.Proc is
(not Is_Attribute,
"illegal attribute declaration for " & Get_Name_String (Name));
- Variable_Element_Table.Increment_Last (In_Tree.Variable_Elements);
- Var := Variable_Element_Table.Last (In_Tree.Variable_Elements);
+ Variable_Element_Table.Increment_Last (Shared.Variable_Elements);
+ Var := Variable_Element_Table.Last (Shared.Variable_Elements);
-- Put the new variable in the appropriate list
if Pkg /= No_Package then
- In_Tree.Variable_Elements.Table (Var) :=
- (Next => In_Tree.Packages.Table (Pkg).Decl.Variables,
+ Shared.Variable_Elements.Table (Var) :=
+ (Next => Shared.Packages.Table (Pkg).Decl.Variables,
Name => Name,
Value => New_Value);
- In_Tree.Packages.Table (Pkg).Decl.Variables := Var;
+ Shared.Packages.Table (Pkg).Decl.Variables := Var;
else
- In_Tree.Variable_Elements.Table (Var) :=
+ Shared.Variable_Elements.Table (Var) :=
(Next => Project.Decl.Variables,
Name => Name,
Value => New_Value);
@@ -2071,7 +2048,7 @@ package body Prj.Proc is
-- change the value.
else
- In_Tree.Variable_Elements.Table (Var).Value := New_Value;
+ Shared.Variable_Elements.Table (Var).Value := New_Value;
end if;
end Process_Expression_Variable_Decl;
@@ -2083,7 +2060,7 @@ package body Prj.Proc is
New_Value : Variable_Value :=
Expression
(Project => Project,
- In_Tree => In_Tree,
+ Shared => Shared,
From_Project_Node => From_Project_Node,
From_Project_Node_Tree => Node_Tree,
Env => Env,
@@ -2173,7 +2150,7 @@ package body Prj.Proc is
Name :=
Name_Of
(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;
Name := Name_Of (Variable_Node, Node_Tree);
@@ -2183,11 +2160,11 @@ package body Prj.Proc is
if The_Package /= No_Package then
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
- and then In_Tree.Variable_Elements.Table (Var_Id).Name /= Name
+ and then Shared.Variable_Elements.Table (Var_Id).Name /= Name
loop
- Var_Id := In_Tree.Variable_Elements.Table (Var_Id).Next;
+ Var_Id := Shared.Variable_Elements.Table (Var_Id).Next;
end loop;
end if;
@@ -2199,9 +2176,9 @@ package body Prj.Proc is
then
Var_Id := The_Project.Decl.Variables;
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
- Var_Id := In_Tree.Variable_Elements.Table (Var_Id).Next;
+ Var_Id := Shared.Variable_Elements.Table (Var_Id).Next;
end loop;
end if;
@@ -2217,7 +2194,7 @@ package body Prj.Proc is
-- 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
@@ -2270,15 +2247,14 @@ package body Prj.Proc is
if Present (Decl_Item) then
Process_Declarative_Items
- (Project => Project,
- In_Tree => In_Tree,
- From_Project_Node => From_Project_Node,
- Node_Tree => Node_Tree,
- Env => Env,
- Pkg => Pkg,
- Item => Decl_Item,
- Child_Env => Child_Env,
- Can_Modify_Child_Env => Can_Modify_Child_Env);
+ (Project => Project,
+ In_Tree => In_Tree,
+ From_Project_Node => From_Project_Node,
+ Node_Tree => Node_Tree,
+ Env => Env,
+ Pkg => Pkg,
+ Item => Decl_Item,
+ Child_Env => Child_Env);
end if;
end Process_Case_Construction;
@@ -2333,8 +2309,6 @@ package body Prj.Proc is
Env : in out Prj.Tree.Environment;
Reset_Tree : Boolean := True)
is
- Child_Env : Prj.Tree.Environment;
-
begin
if Reset_Tree then
@@ -2350,19 +2324,13 @@ package body Prj.Proc is
Debug_Increase_Indent ("Process tree, phase 1");
- Initialize_And_Copy (Child_Env, Copy_From => Env);
-
Recursive_Process
(Project => Project,
In_Tree => In_Tree,
From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree,
Env => Env,
- Extended_By => No_Project,
- Child_Env => Child_Env,
- Is_Root_Project => True);
-
- Free (Child_Env);
+ Extended_By => No_Project);
Success :=
Total_Errors_Detected = 0
@@ -2397,7 +2365,7 @@ package body Prj.Proc is
begin
Success := True;
- Debug_Increase_Indent ("Process tree, phase 2");
+ Debug_Increase_Indent ("Process tree, phase 2", Project.Name);
if Project /= No_Project then
Check (In_Tree, Project, From_Project_Node_Tree, Env.Flags);
@@ -2498,10 +2466,15 @@ package body Prj.Proc is
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
Env : in out Prj.Tree.Environment;
- Extended_By : Project_Id;
- Child_Env : in out Prj.Tree.Environment;
- Is_Root_Project : Boolean)
+ Extended_By : Project_Id)
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
(Imported : in out Project_List;
Limited_With : Boolean);
@@ -2553,9 +2526,7 @@ package body Prj.Proc is
(With_Clause, From_Project_Node_Tree),
From_Project_Node_Tree => From_Project_Node_Tree,
Env => Env,
- Extended_By => No_Project,
- Child_Env => Child_Env,
- Is_Root_Project => False);
+ Extended_By => No_Project);
-- Imported is the id of the last imported project. If
-- it is nil, then this imported project is our first.
@@ -2585,7 +2556,7 @@ package body Prj.Proc is
procedure Process_Aggregated_Projects is
List : Aggregated_Project_List;
- Loaded_Tree : Prj.Tree.Project_Node_Id;
+ Loaded_Project : Prj.Tree.Project_Node_Id;
Success : Boolean := True;
begin
if Project.Qualifier /= Aggregate then
@@ -2604,25 +2575,46 @@ package body Prj.Proc is
while Success and then List /= null loop
Prj.Part.Parse
(In_Tree => From_Project_Node_Tree,
- Project => Loaded_Tree,
+ Project => Loaded_Project,
Project_File_Name => Get_Name_String (List.Path),
Errout_Handling => Prj.Part.Never_Finalize,
Current_Directory => Get_Name_String (Project.Directory.Name),
Is_Config_File => False,
Env => Child_Env);
- Success := not Prj.Tree.No (Loaded_Tree);
+ Success := not Prj.Tree.No (Loaded_Project);
if Success then
- Recursive_Process
- (In_Tree => In_Tree,
- Project => List.Project,
- From_Project_Node => Loaded_Tree,
- From_Project_Node_Tree => From_Project_Node_Tree,
- Env => Child_Env,
- Extended_By => No_Project,
- Child_Env => Child_Env,
- Is_Root_Project => False);
+ List.Tree := new Project_Tree_Data (Is_Root_Tree => False);
+ Prj.Initialize (List.Tree);
+ List.Tree.Shared := In_Tree.Shared;
+
+ -- We can only do the phase 1 of the processing, since we do
+ -- not have access to the configuration file yet (this is
+ -- called when doing phase 1 of the processing for the root
+ -- aggregate project).
+
+ 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
Debug_Output ("Failed to parse", Name_Id (List.Path));
end if;
@@ -2650,21 +2642,20 @@ package body Prj.Proc is
begin
Extended_Pkg := Project.Extends.Decl.Packages;
while Extended_Pkg /= No_Package loop
- Element := In_Tree.Packages.Table (Extended_Pkg);
+ Element := Shared.Packages.Table (Extended_Pkg);
Current_Pkg := First;
while Current_Pkg /= No_Package
- and then In_Tree.Packages.Table (Current_Pkg).Name /=
+ and then Shared.Packages.Table (Current_Pkg).Name /=
Element.Name
loop
- Current_Pkg :=
- In_Tree.Packages.Table (Current_Pkg).Next;
+ Current_Pkg := Shared.Packages.Table (Current_Pkg).Next;
end loop;
if Current_Pkg = No_Package then
- Package_Table.Increment_Last (In_Tree.Packages);
- Current_Pkg := Package_Table.Last (In_Tree.Packages);
- In_Tree.Packages.Table (Current_Pkg) :=
+ Package_Table.Increment_Last (Shared.Packages);
+ Current_Pkg := Package_Table.Last (Shared.Packages);
+ Shared.Packages.Table (Current_Pkg) :=
(Name => Element.Name,
Decl => No_Declarations,
Parent => No_Package,
@@ -2672,10 +2663,10 @@ package body Prj.Proc is
Project.Decl.Packages := Current_Pkg;
Copy_Package_Declarations
(From => Element.Decl,
- To => In_Tree.Packages.Table (Current_Pkg).Decl,
+ To => Shared.Packages.Table (Current_Pkg).Decl,
New_Loc => No_Location,
Restricted => True,
- In_Tree => In_Tree);
+ Shared => Shared);
end if;
Extended_Pkg := Element.Next;
@@ -2685,7 +2676,7 @@ package body Prj.Proc is
Attribute1 := Project.Decl.Attributes;
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;
Attribute1 := Attr_Value1.Next;
end loop;
@@ -2698,7 +2689,7 @@ package body Prj.Proc is
Attribute2 := Project.Extends.Decl.Attributes;
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;
Attribute2 := Attr_Value2.Next;
end loop;
@@ -2711,17 +2702,16 @@ package body Prj.Proc is
if Attribute1 = No_Variable then
Variable_Element_Table.Increment_Last
- (In_Tree.Variable_Elements);
+ (Shared.Variable_Elements);
Attribute1 := Variable_Element_Table.Last
- (In_Tree.Variable_Elements);
+ (Shared.Variable_Elements);
Attr_Value1.Next := Project.Decl.Attributes;
Project.Decl.Attributes := Attribute1;
end if;
Attr_Value1.Name := Snames.Name_Languages;
Attr_Value1.Value := Attr_Value2.Value;
- In_Tree.Variable_Elements.Table
- (Attribute1) := Attr_Value1;
+ Shared.Variable_Elements.Table (Attribute1) := Attr_Value1;
end if;
end if;
end Process_Extended_Project;
@@ -2806,13 +2796,24 @@ package body Prj.Proc is
(Project,
Name,
Name_Id (Project.Directory.Name),
- In_Tree,
+ In_Tree.Shared,
Project.Decl,
Prj.Attr.Attribute_First,
Project_Level => True);
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 :=
Project_Declaration_Of
(From_Project_Node, From_Project_Node_Tree);
@@ -2824,9 +2825,7 @@ package body Prj.Proc is
(Declaration_Node, From_Project_Node_Tree),
From_Project_Node_Tree => From_Project_Node_Tree,
Env => Env,
- Extended_By => Project,
- Child_Env => Child_Env,
- Is_Root_Project => False);
+ Extended_By => Project);
Process_Declarative_Items
(Project => Project,
@@ -2837,8 +2836,7 @@ package body Prj.Proc is
Pkg => No_Package,
Item => First_Declarative_Item_Of
(Declaration_Node, From_Project_Node_Tree),
- Child_Env => Child_Env,
- Can_Modify_Child_Env => Is_Root_Project);
+ Child_Env => Child_Env);
if Project.Extends /= No_Project then
Process_Extended_Project;
@@ -2849,6 +2847,12 @@ package body Prj.Proc is
if Err_Vars.Total_Errors_Detected = 0 then
Process_Aggregated_Projects;
end if;
+
+ if Project.Qualifier = Aggregate
+ and then In_Tree.Is_Root_Tree
+ then
+ Free (Child_Env);
+ end if;
end;
end if;
end Recursive_Process;
diff --git a/gcc/ada/prj-proc.ads b/gcc/ada/prj-proc.ads
index 4610fdfc99b..f7fb7ad1411 100644
--- a/gcc/ada/prj-proc.ads
+++ b/gcc/ada/prj-proc.ads
@@ -72,7 +72,7 @@ package Prj.Proc is
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
Env : in out Prj.Tree.Environment;
- Reset_Tree : Boolean := True);
+ Reset_Tree : Boolean := True);
-- Performs the two phases of the processing
end Prj.Proc;
diff --git a/gcc/ada/prj-util.adb b/gcc/ada/prj-util.adb
index 494b04c482e..42f08ab3a64 100644
--- a/gcc/ada/prj-util.adb
+++ b/gcc/ada/prj-util.adb
@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -129,7 +129,7 @@ package body Prj.Util is
procedure Duplicate
(This : in out Name_List_Index;
- In_Tree : Project_Tree_Ref)
+ Shared : Shared_Project_Tree_Data_Access)
is
Old_Current : Name_List_Index;
New_Current : Name_List_Index;
@@ -137,20 +137,20 @@ package body Prj.Util is
begin
if This /= No_Name_List then
Old_Current := This;
- Name_List_Table.Increment_Last (In_Tree.Name_Lists);
- New_Current := Name_List_Table.Last (In_Tree.Name_Lists);
+ Name_List_Table.Increment_Last (Shared.Name_Lists);
+ New_Current := Name_List_Table.Last (Shared.Name_Lists);
This := New_Current;
- In_Tree.Name_Lists.Table (New_Current) :=
- (In_Tree.Name_Lists.Table (Old_Current).Name, No_Name_List);
+ Shared.Name_Lists.Table (New_Current) :=
+ (Shared.Name_Lists.Table (Old_Current).Name, No_Name_List);
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;
- In_Tree.Name_Lists.Table (New_Current).Next := New_Current + 1;
- Name_List_Table.Increment_Last (In_Tree.Name_Lists);
+ Shared.Name_Lists.Table (New_Current).Next := New_Current + 1;
+ Name_List_Table.Increment_Last (Shared.Name_Lists);
New_Current := New_Current + 1;
- In_Tree.Name_Lists.Table (New_Current) :=
- (In_Tree.Name_Lists.Table (Old_Current).Name, No_Name_List);
+ Shared.Name_Lists.Table (New_Current) :=
+ (Shared.Name_Lists.Table (Old_Current).Name, No_Name_List);
end loop;
end if;
end Duplicate;
@@ -174,7 +174,7 @@ package body Prj.Util is
function Executable_Of
(Project : Project_Id;
- In_Tree : Project_Tree_Ref;
+ Shared : Shared_Project_Tree_Data_Access;
Main : File_Name_Type;
Index : Int;
Ada_Main : Boolean := True;
@@ -189,7 +189,7 @@ package body Prj.Util is
Prj.Util.Value_Of
(Name => Name_Builder,
In_Packages => The_Packages,
- In_Tree => In_Tree);
+ Shared => Shared);
Executable : Variable_Value :=
Prj.Util.Value_Of
@@ -197,7 +197,7 @@ package body Prj.Util is
Index => Index,
Attribute_Or_Array_Name => Name_Executable,
In_Package => Builder_Package,
- In_Tree => In_Tree);
+ Shared => Shared);
Lang : Language_Ptr;
@@ -266,8 +266,8 @@ package body Prj.Util is
Prj.Util.Value_Of
(Variable_Name => Name_Executable_Suffix,
In_Variables =>
- In_Tree.Packages.Table (Builder_Package).Decl.Attributes,
- In_Tree => In_Tree);
+ Shared.Packages.Table (Builder_Package).Decl.Attributes,
+ Shared => Shared);
if Suffix_From_Project /= Nil_Variable_Value
and then Suffix_From_Project.Value /= No_Name
@@ -340,7 +340,7 @@ package body Prj.Util is
Index => 0,
Attribute_Or_Array_Name => Name_Executable,
In_Package => Builder_Package,
- In_Tree => In_Tree);
+ Shared => Shared);
end if;
end;
end if;
@@ -554,24 +554,26 @@ package body Prj.Util is
In_Tree : Project_Tree_Ref;
Lower_Case : Boolean := False)
is
+ Shared : constant Shared_Project_Tree_Data_Access := In_Tree.Shared;
+
Current_Name : Name_List_Index;
List : String_List_Id;
Element : String_Element;
Last : Name_List_Index :=
- Name_List_Table.Last (In_Tree.Name_Lists);
+ Name_List_Table.Last (Shared.Name_Lists);
Value : Name_Id;
begin
Current_Name := Into_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
- Current_Name := In_Tree.Name_Lists.Table (Current_Name).Next;
+ Current_Name := Shared.Name_Lists.Table (Current_Name).Next;
end loop;
List := From_List;
while List /= Nil_String loop
- Element := In_Tree.String_Elements.Table (List);
+ Element := Shared.String_Elements.Table (List);
Value := Element.Value;
if Lower_Case then
@@ -581,15 +583,14 @@ package body Prj.Util is
end if;
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;
if Current_Name = No_Name_List then
Into_List := Last;
-
else
- In_Tree.Name_Lists.Table (Current_Name).Next := Last;
+ Shared.Name_Lists.Table (Current_Name).Next := Last;
end if;
Current_Name := Last;
@@ -808,8 +809,9 @@ package body Prj.Util is
function Value_Of
(Index : Name_Id;
In_Array : Array_Element_Id;
- In_Tree : Project_Tree_Ref) return Name_Id
+ Shared : Shared_Project_Tree_Data_Access) return Name_Id
is
+
Current : Array_Element_Id;
Element : Array_Element;
Real_Index : Name_Id := Index;
@@ -821,7 +823,7 @@ package body Prj.Util is
return No_Name;
end if;
- Element := In_Tree.Array_Elements.Table (Current);
+ Element := Shared.Array_Elements.Table (Current);
if not Element.Index_Case_Sensitive then
Get_Name_String (Index);
@@ -830,7 +832,7 @@ package body Prj.Util is
end if;
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
exit when Element.Value.Kind /= Single;
@@ -848,7 +850,7 @@ package body Prj.Util is
(Index : Name_Id;
Src_Index : Int := 0;
In_Array : Array_Element_Id;
- In_Tree : Project_Tree_Ref;
+ Shared : Shared_Project_Tree_Data_Access;
Force_Lower_Case_Index : Boolean := False;
Allow_Wildcards : Boolean := False) return Variable_Value
is
@@ -864,7 +866,7 @@ package body Prj.Util is
return Nil_Variable_Value;
end if;
- Element := In_Tree.Array_Elements.Table (Current);
+ Element := Shared.Array_Elements.Table (Current);
Real_Index_1 := Index;
@@ -877,7 +879,7 @@ package body Prj.Util is
end if;
while Current /= No_Array_Element loop
- Element := In_Tree.Array_Elements.Table (Current);
+ Element := Shared.Array_Elements.Table (Current);
Real_Index_2 := Element.Index;
if not Element.Index_Case_Sensitive
@@ -912,7 +914,7 @@ package body Prj.Util is
Index : Int := 0;
Attribute_Or_Array_Name : Name_Id;
In_Package : Package_Id;
- In_Tree : Project_Tree_Ref;
+ Shared : Shared_Project_Tree_Data_Access;
Force_Lower_Case_Index : Boolean := False;
Allow_Wildcards : Boolean := False) return Variable_Value
is
@@ -927,14 +929,14 @@ package body Prj.Util is
The_Array :=
Value_Of
(Name => Attribute_Or_Array_Name,
- In_Arrays => In_Tree.Packages.Table (In_Package).Decl.Arrays,
- In_Tree => In_Tree);
+ In_Arrays => Shared.Packages.Table (In_Package).Decl.Arrays,
+ Shared => Shared);
The_Attribute :=
Value_Of
(Index => Name,
Src_Index => Index,
In_Array => The_Array,
- In_Tree => In_Tree,
+ Shared => Shared,
Force_Lower_Case_Index => Force_Lower_Case_Index,
Allow_Wildcards => Allow_Wildcards);
@@ -944,9 +946,9 @@ package body Prj.Util is
The_Attribute :=
Value_Of
(Variable_Name => Attribute_Or_Array_Name,
- In_Variables => In_Tree.Packages.Table
- (In_Package).Decl.Attributes,
- In_Tree => In_Tree);
+ In_Variables => Shared.Packages.Table
+ (In_Package).Decl.Attributes,
+ Shared => Shared);
end if;
end if;
@@ -957,7 +959,7 @@ package body Prj.Util is
(Index : Name_Id;
In_Array : Name_Id;
In_Arrays : Array_Id;
- In_Tree : Project_Tree_Ref) return Name_Id
+ Shared : Shared_Project_Tree_Data_Access) return Name_Id
is
Current : Array_Id;
The_Array : Array_Data;
@@ -965,10 +967,10 @@ package body Prj.Util is
begin
Current := In_Arrays;
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
return Value_Of
- (Index, In_Array => The_Array.Value, In_Tree => In_Tree);
+ (Index, In_Array => The_Array.Value, Shared => Shared);
else
Current := The_Array.Next;
end if;
@@ -980,7 +982,7 @@ package body Prj.Util is
function Value_Of
(Name : Name_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
Current : Array_Id;
The_Array : Array_Data;
@@ -988,7 +990,7 @@ package body Prj.Util is
begin
Current := In_Arrays;
while Current /= No_Array loop
- The_Array := In_Tree.Arrays.Table (Current);
+ The_Array := Shared.Arrays.Table (Current);
if The_Array.Name = Name then
return The_Array.Value;
@@ -1003,7 +1005,7 @@ package body Prj.Util is
function Value_Of
(Name : Name_Id;
In_Packages : Package_Id;
- In_Tree : Project_Tree_Ref) return Package_Id
+ Shared : Shared_Project_Tree_Data_Access) return Package_Id
is
Current : Package_Id;
The_Package : Package_Element;
@@ -1011,7 +1013,7 @@ package body Prj.Util is
begin
Current := In_Packages;
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
and then The_Package.Name = Name;
Current := The_Package.Next;
@@ -1023,7 +1025,7 @@ package body Prj.Util is
function Value_Of
(Variable_Name : Name_Id;
In_Variables : Variable_Id;
- In_Tree : Project_Tree_Ref) return Variable_Value
+ Shared : Shared_Project_Tree_Data_Access) return Variable_Value
is
Current : Variable_Id;
The_Variable : Variable;
@@ -1031,8 +1033,7 @@ package body Prj.Util is
begin
Current := In_Variables;
while Current /= No_Variable loop
- The_Variable :=
- In_Tree.Variable_Elements.Table (Current);
+ The_Variable := Shared.Variable_Elements.Table (Current);
if Variable_Name = The_Variable.Name then
return The_Variable.Value;
diff --git a/gcc/ada/prj-util.ads b/gcc/ada/prj-util.ads
index 741dc7f048d..7c94a3c8572 100644
--- a/gcc/ada/prj-util.ads
+++ b/gcc/ada/prj-util.ads
@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -29,7 +29,7 @@ package Prj.Util is
function Executable_Of
(Project : Project_Id;
- In_Tree : Project_Tree_Ref;
+ Shared : Shared_Project_Tree_Data_Access;
Main : File_Name_Type;
Index : Int;
Ada_Main : Boolean := True;
@@ -61,7 +61,7 @@ package Prj.Util is
procedure Duplicate
(This : in out Name_List_Index;
- In_Tree : Project_Tree_Ref);
+ Shared : Shared_Project_Tree_Data_Access);
-- Duplicate a name list
function Value_Of
@@ -73,7 +73,7 @@ package Prj.Util is
function Value_Of
(Index : Name_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
-- component Index, if In_Array is null, or if the component is a String
-- list. Depending on the attribute (only attributes may be associative
@@ -85,7 +85,7 @@ package Prj.Util is
(Index : Name_Id;
Src_Index : Int := 0;
In_Array : Array_Element_Id;
- In_Tree : Project_Tree_Ref;
+ Shared : Shared_Project_Tree_Data_Access;
Force_Lower_Case_Index : Boolean := False;
Allow_Wildcards : Boolean := False) return Variable_Value;
-- Get a string array component (single String or String list). Returns
@@ -101,7 +101,7 @@ package Prj.Util is
Index : Int := 0;
Attribute_Or_Array_Name : Name_Id;
In_Package : Package_Id;
- In_Tree : Project_Tree_Ref;
+ Shared : Shared_Project_Tree_Data_Access;
Force_Lower_Case_Index : Boolean := False;
Allow_Wildcards : Boolean := False) return Variable_Value;
-- In a specific package:
@@ -117,7 +117,7 @@ package Prj.Util is
(Index : Name_Id;
In_Array : Name_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
-- 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.
@@ -125,7 +125,7 @@ package Prj.Util is
function Value_Of
(Name : Name_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
-- 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.
@@ -133,7 +133,7 @@ package Prj.Util is
function Value_Of
(Name : Name_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
-- 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.
@@ -141,7 +141,7 @@ package Prj.Util is
function Value_Of
(Variable_Name : Name_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
-- 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.
diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb
index cc5733555a6..58160e61d48 100644
--- a/gcc/ada/prj.adb
+++ b/gcc/ada/prj.adb
@@ -404,6 +404,7 @@ package body Prj is
procedure For_Every_Project_Imported
(By : Project_Id;
+ Tree : Project_Tree_Ref;
With_State : in out State;
Include_Aggregated : Boolean := True;
Imported_First : Boolean := False)
@@ -411,7 +412,8 @@ package body Prj is
use Project_Boolean_Htable;
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
-- Seen, Call Action, and check all its imported projects.
@@ -419,29 +421,34 @@ package body Prj is
-- Recursive_Check --
---------------------
- procedure Recursive_Check (Project : Project_Id) is
+ procedure Recursive_Check
+ (Project : Project_Id; Tree : Project_Tree_Ref)
+ is
List : Project_List;
Agg : Aggregated_Project_List;
begin
if not Get (Seen, Project) then
+ -- Even if a project is aggregated multiple times, we will only
+ -- return it once.
+
Set (Seen, Project, True);
if not Imported_First then
- Action (Project, With_State);
+ Action (Project, Tree, With_State);
end if;
-- Visit all extended projects
if Project.Extends /= No_Project then
- Recursive_Check (Project.Extends);
+ Recursive_Check (Project.Extends, Tree);
end if;
-- Visit all imported projects
List := Project.Imported_Projects;
while List /= null loop
- Recursive_Check (List.Project);
+ Recursive_Check (List.Project, Tree);
List := List.Next;
end loop;
@@ -453,13 +460,13 @@ package body Prj is
Agg := Project.Aggregated_Projects;
while Agg /= null loop
pragma Assert (Agg.Project /= No_Project);
- Recursive_Check (Agg.Project);
+ Recursive_Check (Agg.Project, Agg.Tree);
Agg := Agg.Next;
end loop;
end if;
if Imported_First then
- Action (Project, With_State);
+ Action (Project, Tree, With_State);
end if;
end if;
end Recursive_Check;
@@ -467,7 +474,7 @@ package body Prj is
-- Start of processing for For_Every_Project_Imported
begin
- Recursive_Check (Project => By);
+ Recursive_Check (Project => By, Tree => Tree);
Reset (Seen);
end For_Every_Project_Imported;
@@ -484,18 +491,25 @@ package body Prj is
is
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_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;
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
if Element (Iterator).File = Base_Name then
Src := Element (Iterator);
@@ -517,22 +531,23 @@ package body Prj is
if In_Extended_Only then
Proj := Project;
while Proj /= No_Project loop
- Look_For_Sources (Proj, Result);
+ Look_For_Sources (Proj, In_Tree, Result);
exit when Result /= No_Source;
Proj := Proj.Extends;
end loop;
elsif In_Imported_Only then
- Look_For_Sources (Project, Result);
+ Look_For_Sources (Project, In_Tree, Result);
if Result = No_Source then
For_Imported_Projects
(By => Project,
+ Tree => In_Tree,
With_State => Result);
end if;
else
- Look_For_Sources (No_Project, Result);
+ Look_For_Sources (No_Project, In_Tree, Result);
end if;
return Result;
@@ -604,12 +619,9 @@ package body Prj is
Prj.Attr.Initialize;
- Set_Name_Table_Byte
- (Name_Project, Token_Type'Pos (Tok_Project));
- Set_Name_Table_Byte
- (Name_Extends, Token_Type'Pos (Tok_Extends));
- Set_Name_Table_Byte
- (Name_External, Token_Type'Pos (Tok_External));
+ Set_Name_Table_Byte (Name_Project, Token_Type'Pos (Tok_Project));
+ Set_Name_Table_Byte (Name_Extends, Token_Type'Pos (Tok_Extends));
+ Set_Name_Table_Byte (Name_External, Token_Type'Pos (Tok_External));
Set_Name_Table_Byte
(Name_External_As_List, Token_Type'Pos (Tok_External_As_List));
end if;
@@ -716,6 +728,9 @@ package body Prj is
begin
while List /= null loop
Tmp := List.Next;
+
+ Free (List.Tree);
+
Unchecked_Free (List);
List := Tmp;
end loop;
@@ -731,6 +746,7 @@ package body Prj is
Project.Aggregated_Projects := new Aggregated_Project'
(Path => Path,
Project => No_Project,
+ Tree => null,
Next => Project.Aggregated_Projects);
end Add_Aggregated_Project;
@@ -888,13 +904,16 @@ package body Prj is
begin
if Tree /= null then
- Name_List_Table.Free (Tree.Name_Lists);
- Number_List_Table.Free (Tree.Number_Lists);
- String_Element_Table.Free (Tree.String_Elements);
- Variable_Element_Table.Free (Tree.Variable_Elements);
- Array_Element_Table.Free (Tree.Array_Elements);
- Array_Table.Free (Tree.Arrays);
- Package_Table.Free (Tree.Packages);
+ if Tree.Is_Root_Tree then
+ Name_List_Table.Free (Tree.Shared.Name_Lists);
+ Number_List_Table.Free (Tree.Shared.Number_Lists);
+ String_Element_Table.Free (Tree.Shared.String_Elements);
+ Variable_Element_Table.Free (Tree.Shared.Variable_Elements);
+ Array_Element_Table.Free (Tree.Shared.Array_Elements);
+ Array_Table.Free (Tree.Shared.Arrays);
+ Package_Table.Free (Tree.Shared.Packages);
+ end if;
+
Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
Source_Files_Htable.Reset (Tree.Source_Files_HT);
@@ -917,13 +936,21 @@ package body Prj is
begin
-- Visible tables
- Name_List_Table.Init (Tree.Name_Lists);
- Number_List_Table.Init (Tree.Number_Lists);
- String_Element_Table.Init (Tree.String_Elements);
- Variable_Element_Table.Init (Tree.Variable_Elements);
- Array_Element_Table.Init (Tree.Array_Elements);
- Array_Table.Init (Tree.Arrays);
- Package_Table.Init (Tree.Packages);
+ if Tree.Is_Root_Tree then
+ -- We cannot use 'Access here:
+ -- "illegal attribute for discriminant-dependent component"
+ -- However, we know this is valid since Shared and Shared_Data have
+ -- the same lifetime and will always exist concurrently.
+ Tree.Shared := Tree.Shared_Data'Unrestricted_Access;
+ 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_Files_Htable.Reset (Tree.Source_Files_HT);
Replaced_Source_HTable.Reset (Tree.Replaced_Sources);
@@ -1110,7 +1137,10 @@ package body Prj is
procedure Compute_All_Imported_Projects (Tree : Project_Tree_Ref) is
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
-- those that are extended.
@@ -1118,8 +1148,12 @@ package body Prj is
-- Recursive_Add --
-------------------
- procedure Recursive_Add (Prj : Project_Id; Dummy : in out Boolean) is
- pragma Unreferenced (Dummy);
+ procedure Recursive_Add
+ (Prj : Project_Id;
+ Tree : Project_Tree_Ref;
+ Dummy : in out Boolean)
+ is
+ pragma Unreferenced (Dummy, Tree);
List : Project_List;
Prj2 : Project_Id;
@@ -1163,7 +1197,7 @@ package body Prj is
while List /= null loop
Project := List.Project;
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;
end loop;
end Compute_All_Imported_Projects;
diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads
index 1e60bdc6f8b..9928bd3b205 100644
--- a/gcc/ada/prj.ads
+++ b/gcc/ada/prj.ads
@@ -1094,6 +1094,7 @@ package Prj is
type Aggregated_Project_List is access all Aggregated_Project;
type Aggregated_Project is record
Path : Path_Name_Type;
+ Tree : Project_Tree_Ref;
Project : Project_Id;
Next : Aggregated_Project_List;
end record;
@@ -1400,41 +1401,68 @@ package Prj is
type Private_Project_Tree_Data is private;
-- Data for a project tree that is used only by the Project Manager
- type Project_Tree_Data is
- record
- Name_Lists : Name_List_Table.Instance;
- Number_Lists : Number_List_Table.Instance;
- String_Elements : String_Element_Table.Instance;
- Variable_Elements : Variable_Element_Table.Instance;
- Array_Elements : Array_Element_Table.Instance;
- Arrays : Array_Table.Instance;
- Packages : Package_Table.Instance;
- Projects : Project_List;
+ type Shared_Project_Tree_Data is record
+ Name_Lists : Name_List_Table.Instance;
+ Number_Lists : Number_List_Table.Instance;
+ String_Elements : String_Element_Table.Instance;
+ Variable_Elements : Variable_Element_Table.Instance;
+ Array_Elements : Array_Element_Table.Instance;
+ Arrays : Array_Table.Instance;
+ Packages : Package_Table.Instance;
+ end record;
+ type Shared_Project_Tree_Data_Access is access all Shared_Project_Tree_Data;
+ -- The data that is shared among multiple trees, when these trees are
+ -- 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;
- -- The list of sources that have been replaced by sources with
- -- different file names.
+ Units_HT : Units_Htable.Instance;
+ -- Unit name to Unit_Index (and from there to Source_Id)
- Replaced_Source_Number : Natural := 0;
- -- The number of entries in Replaced_Sources
+ Source_Files_HT : Source_Files_Htable.Instance;
+ -- Base source file names to Source_Id list.
- Units_HT : Units_Htable.Instance;
- -- Unit name to Unit_Index (and from there to Source_Id)
+ Source_Paths_HT : Source_Paths_Htable.Instance;
+ -- Full path to Source_Id
- Source_Files_HT : Source_Files_Htable.Instance;
- -- Base source file names to Source_Id list.
+ Source_Info_File_Name : String_Access := null;
+ -- The name of the source info file, if specified by the builder
- Source_Paths_HT : Source_Paths_Htable.Instance;
- -- Full path to Source_Id
+ Source_Info_File_Exists : Boolean := False;
+ -- True when a source info file has been successfully read
- Source_Info_File_Name : String_Access := null;
- -- The name of the source info file, if specified by the builder
+ Private_Part : Private_Project_Tree_Data;
- Source_Info_File_Exists : Boolean := False;
- -- True when a source info file has been successfully read
+ Shared : Shared_Project_Tree_Data_Access;
+ -- The shared data for this tree and all aggregated trees.
- Private_Part : Private_Project_Tree_Data;
- end record;
+ case Is_Root_Tree is
+ when True =>
+ Shared_Data : aliased Shared_Project_Tree_Data;
+ -- Do not access directly, only through Shared.
+
+ when False =>
+ null;
+ end case;
+ end record;
-- Data for a project tree
procedure Expect (The_Token : Token_Type; Token_Image : String);
@@ -1463,9 +1491,11 @@ package Prj is
type State is limited private;
with procedure Action
(Project : Project_Id;
+ Tree : Project_Tree_Ref;
With_State : in out State);
procedure For_Every_Project_Imported
(By : Project_Id;
+ Tree : Project_Tree_Ref;
With_State : in out State;
Include_Aggregated : Boolean := True;
Imported_First : Boolean := False);
@@ -1488,6 +1518,9 @@ package Prj is
-- If Include_Aggregated is True, then an aggregate project will recurse
-- into the projects it aggregates. Otherwise, the latter are never
-- 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
(File : File_Name_Type;
View Lorry Controller Status