+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,
Executable :=
Executable_Of
(Main_Project,
- Project_Tree,
+ Project_Tree.Shared,
Main_Source_File,
Current_File_Index);
-- 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;
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);
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.
B_Start.all &
MLib.Fil.Ext_To
(Get_Name_String
- (Project_Tree.String_Elements.Table
+ (Project_Tree.Shared.String_Elements.Table
(Main).Value),
"ci"));
"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
-- 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
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;
Prj.Util.Value_Of
(Name => Tool_Package_Name,
In_Packages => Project.Decl.Packages,
- In_Tree => Project_Tree);
+ Shared => Project_Tree.Shared);
Element : Package_Element;
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.
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),
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
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;
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
Prj.Util.Value_Of
(Name => Name_Compiler,
In_Packages => Project.Decl.Packages,
- In_Tree => Project_Tree);
+ Shared => Project_Tree.Shared);
Element : Package_Element;
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.
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")
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
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 :=
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
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
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
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
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
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
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
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
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;
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);
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) /= "";
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) /= "";
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;
Prj.Util.Value_Of
(Name_Languages,
Main_Project.Decl.Attributes,
- Project_Tree);
+ Project_Tree.Shared);
Current : String_List_Id;
Element : String_Element;
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));
-- 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
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
end if;
end;
- Value := Project_Tree.String_Elements.Table
+ Value := Project_Tree.Shared.String_Elements.Table
(Value).Next;
end loop;
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;
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
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
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
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
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);
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
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;
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
-- 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);
(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,
Prj.Util.Value_Of
(Name => Pkg_Name,
In_Packages => Project.Decl.Packages,
- In_Tree => Project_Tree);
+ Shared => Project_Tree.Shared);
Lang : Language_Ptr;
begin
(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;
(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;
(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;
(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;
(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;
(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;
(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;
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
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.
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;
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
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;
-- 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=";
-- --
-- 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- --
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
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;
(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;
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;
-- 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
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
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;
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;
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 --
--------------------
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;
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
-- 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
-- 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;
-- 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
-- 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;
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;
-- 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
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;
-- 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.
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;
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;
-----------------------
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;
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;
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;
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
Value_Of
(Name_Source_Dirs,
Project.Decl.Attributes,
- Project_Tree);
+ Shared);
if Variable = Nil_Variable_Value
or else Variable.Default
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;
-- 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;
Value_Of
(Name_Languages,
Prj_Iter.Project.Decl.Attributes,
- Project_Tree);
+ Shared);
if Variable = Nil_Variable_Value
or else Variable.Default
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;
Value_Of
(Name_Default_Language,
Prj_Iter.Project.Decl.Attributes,
- Project_Tree);
+ Shared);
if Variable /= Nil_Variable_Value
and then not Variable.Default
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));
(Name,
Attribute_Or_Array_Name => Name_Compiler_Command,
In_Package => IDE,
- In_Tree => Project_Tree,
+ Shared => Shared,
Force_Lower_Case_Index => True);
declare
Value_Of
(Name_Object_Dir,
Project.Decl.Attributes,
- Project_Tree);
+ Shared);
Gprconfig_Path : String_Access;
Success : Boolean;
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;
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
-- 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);
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
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.
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
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;
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);
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,
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);
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
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;
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;
-- 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
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.
-- 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;
-- 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
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)
---------------------
-- 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;
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;
-- 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 ?
-- 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;
-------------------------
(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;
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;
-- 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;
-------------------
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.
-- 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;
-- 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;
-- 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
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
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.
-- 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);
Add_Src : Boolean;
Source : Source_Id;
Prev_Unit : Unit_Index := No_Unit_Index;
-
Source_To_Replace : Source_Id := No_Source;
begin
Prj.Util.Value_Of
(Snames.Name_Project_Files,
Project.Decl.Attributes,
- Tree);
+ Tree.Shared);
Project_Path_For_Aggregate : Prj.Env.Project_Search_Path;
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
(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
(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
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;
(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;
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
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
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
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
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
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
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 =>
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
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
(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
(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;
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;
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;
(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;
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
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 :=
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 =>
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);
(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
(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 :=
(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
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;
-- 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));
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 :=
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));
("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;
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;
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;
(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;
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 =
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 =
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 =
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 =
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
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
(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;
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
-- 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));
(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;
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
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
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
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
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.
(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;
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
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,
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
-- 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;
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;
(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;
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
(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;
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
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
(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;
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);
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,
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;
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;
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;
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.
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;
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;
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
---------------------
---------------------
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
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
(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);
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
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;
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;
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
(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)
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;
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;
-- 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
-- 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
-- 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
-- Copy the array element
- Elm := In_Tree.Array_Elements.Table (E1);
+ Elm := Shared.Array_Elements.Table (E1);
E1 := Elm.Next;
-- Remove the Next component
-- 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;
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;
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),
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,
(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,
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,
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,
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
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;
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;
"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
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,
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
when Single =>
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 :=
+ 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
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 =>
Next => Nil_String,
Index => 0);
- The_List :=
- In_Tree. String_Elements.Table
+ The_List := Shared.String_Elements.Table
(The_List).Next;
end loop;
end;
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,
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 =>
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 =>
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;
-- 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
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);
-- 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 :=
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
Renamed_Package : constant Package_Id :=
Package_From
- (Renamed_Project, In_Tree,
+ (Renamed_Project, Shared,
Name_Of (Current_Item, Node_Tree));
begin
-- 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
(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);
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;
-- 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,
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
Project);
else
- Orig_Element := In_Tree.Arrays.Table (Orig_Array).Value;
+ Orig_Element := Shared.Arrays.Table (Orig_Array).Value;
-- Copy each array element
-- 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
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
-- 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;
-- 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.
-- 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,
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
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
-- 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),
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;
-- 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
(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);
-- 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;
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,
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);
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;
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;
-- Get the case variable
- The_Variable := In_Tree.Variable_Elements. Table (Var_Id).Value;
+ The_Variable := Shared.Variable_Elements. Table (Var_Id).Value;
if The_Variable.Kind /= Single then
if 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;
Env : in out Prj.Tree.Environment;
Reset_Tree : Boolean := True)
is
- Child_Env : Prj.Tree.Environment;
-
begin
if Reset_Tree then
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
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);
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);
(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.
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
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;
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,
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;
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;
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;
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;
(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);
(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,
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;
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;
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;
-- --
-- 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- --
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;
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;
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;
Prj.Util.Value_Of
(Name => Name_Builder,
In_Packages => The_Packages,
- In_Tree => In_Tree);
+ Shared => Shared);
Executable : Variable_Value :=
Prj.Util.Value_Of
Index => Index,
Attribute_Or_Array_Name => Name_Executable,
In_Package => Builder_Package,
- In_Tree => In_Tree);
+ Shared => Shared);
Lang : Language_Ptr;
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
Index => 0,
Attribute_Or_Array_Name => Name_Executable,
In_Package => Builder_Package,
- In_Tree => In_Tree);
+ Shared => Shared);
end if;
end;
end if;
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
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;
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;
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);
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;
(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
return Nil_Variable_Value;
end if;
- Element := In_Tree.Array_Elements.Table (Current);
+ Element := Shared.Array_Elements.Table (Current);
Real_Index_1 := Index;
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
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
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);
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;
(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;
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;
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;
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;
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;
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;
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;
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;
-- --
-- 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- --
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;
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
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
(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
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:
(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.
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.
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.
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.
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)
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.
-- 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;
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;
-- 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;
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);
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;
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;
begin
while List /= null loop
Tmp := List.Next;
+
+ Free (List.Tree);
+
Unchecked_Free (List);
List := Tmp;
end loop;
Project.Aggregated_Projects := new Aggregated_Project'
(Path => Path,
Project => No_Project,
+ Tree => null,
Next => Project.Aggregated_Projects);
end Add_Aggregated_Project;
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);
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);
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.
-- 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;
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;
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;
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);
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);
-- 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;
projects / gcc.git / commitdiff