Skip to content

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

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

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

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

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

From-SVN: r177261
parent 9fde638d
Showing with 236 additions and 148 deletions
gcc/ada/ChangeLog
2011-08-03 Emmanuel Briot <briot@adacore.com>
* gnatcmd.adb, prj-proc.adb, prj-proc.ads, make.adb, mlib-prj.adb,
prj.adb, prj.ads, makeutl.adb, makeutl.ads, clean.adb, prj-nmsc.adb,
prj-util.adb, prj-util.ads, prj-conf.adb, prj-conf.ads, prj-env.adb,
prj-env.ads (Shared_Project_Tree_Data): new type
An aggregate project and its aggregated trees need to share the common
data structures used for lists of strings, packages,... This makes the
code simpler since otherwise we have to pass the root tree (also used
for the configuration file data) in addition to the current project
tree. This also avoids ambiguities as to which tree should be used.
And finally this saves a bit of memory.
(For_Every_Project_Imported): new parameter Tree.
Since aggregated projects are using a different tree, we need to let
the caller know which tree to use to manipulate the returned project.
2011-08-03 Robert Dewar <dewar@adacore.com>
* prj-proc.adb, exp_util.ads, exp_ch9.adb, make.adb, prj-ext.adb,
......
gcc/ada/clean.adb
......@@ -1170,7 +1170,7 @@ package body Clean is
Executable :=
Executable_Of
(Main_Project,
Project_Tree,
Project_Tree.Shared,
Main_Source_File,
Current_File_Index);
......@@ -1425,7 +1425,7 @@ package body Clean is
-- Add source directories and object directories to the search paths
Add_Source_Directories (Main_Project, Project_Tree);
Add_Object_Directories (Main_Project);
Add_Object_Directories (Main_Project, Project_Tree);
end if;
Osint.Add_Default_Search_Dirs;
......@@ -1440,7 +1440,7 @@ package body Clean is
Value : String_List_Id := Main_Project.Mains;
begin
while Value /= Prj.Nil_String loop
Main := Project_Tree.String_Elements.Table (Value);
Main := Project_Tree.Shared.String_Elements.Table (Value);
Osint.Add_File
(File_Name => Get_Name_String (Main.Value),
Index => Main.Index);
......
gcc/ada/makeutl.adb
......@@ -695,7 +695,7 @@ package body Makeutl is
Prj.Util.Value_Of
(Name => Pkg_Name,
In_Packages => Project.Decl.Packages,
In_Tree => Project_Tree);
Shared => Project_Tree.Shared);
Lang : Language_Ptr;
begin
......@@ -706,7 +706,7 @@ package body Makeutl is
(Name => Name_Id (Source_File),
Attribute_Or_Array_Name => Name_Switches,
In_Package => Pkg,
In_Tree => Project_Tree,
Shared => Project_Tree.Shared,
Allow_Wildcards => True);
end if;
......@@ -756,7 +756,7 @@ package body Makeutl is
(Name => Name_Find,
Attribute_Or_Array_Name => Name_Switches,
In_Package => Pkg,
In_Tree => Project_Tree,
Shared => Project_Tree.Shared,
Allow_Wildcards => True);
end if;
......@@ -776,7 +776,7 @@ package body Makeutl is
(Name => Name_Find,
Attribute_Or_Array_Name => Name_Switches,
In_Package => Pkg,
In_Tree => Project_Tree,
Shared => Project_Tree.Shared,
Allow_Wildcards => True);
end if;
end;
......@@ -790,7 +790,7 @@ package body Makeutl is
(Name => Source_Lang,
Attribute_Or_Array_Name => Name_Switches,
In_Package => Pkg,
In_Tree => Project_Tree,
Shared => Project_Tree.Shared,
Force_Lower_Case_Index => True);
end if;
......@@ -800,7 +800,7 @@ package body Makeutl is
(Name => All_Other_Names,
Attribute_Or_Array_Name => Name_Switches,
In_Package => Pkg,
In_Tree => Project_Tree,
Shared => Project_Tree.Shared,
Force_Lower_Case_Index => True);
end if;
......@@ -810,7 +810,7 @@ package body Makeutl is
(Name => Source_Lang,
Attribute_Or_Array_Name => Name_Default_Switches,
In_Package => Pkg,
In_Tree => Project_Tree);
Shared => Project_Tree.Shared);
end if;
end Get_Switches;
......@@ -910,14 +910,21 @@ package body Makeutl is
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return String_List
is
procedure Recursive_Add (Proj : Project_Id; Dummy : in out Boolean);
procedure Recursive_Add
(Proj : Project_Id;
In_Tree : Project_Tree_Ref;
Dummy : in out Boolean);
-- The recursive routine used to add linker options
-------------------
-- Recursive_Add --
-------------------
procedure Recursive_Add (Proj : Project_Id; Dummy : in out Boolean) is
procedure Recursive_Add
(Proj : Project_Id;
In_Tree : Project_Tree_Ref;
Dummy : in out Boolean)
is
pragma Unreferenced (Dummy);
Linker_Package : Package_Id;
......@@ -928,7 +935,7 @@ package body Makeutl is
Prj.Util.Value_Of
(Name => Name_Linker,
In_Packages => Proj.Decl.Packages,
In_Tree => In_Tree);
Shared => In_Tree.Shared);
Options :=
Prj.Util.Value_Of
......@@ -936,7 +943,7 @@ package body Makeutl is
Index => 0,
Attribute_Or_Array_Name => Name_Linker_Options,
In_Package => Linker_Package,
In_Tree => In_Tree);
Shared => In_Tree.Shared);
-- If attribute is present, add the project with
-- the attribute to table Linker_Opts.
......@@ -958,7 +965,7 @@ package body Makeutl is
begin
Linker_Opts.Init;
For_All_Projects (Project, Dummy, Imported_First => True);
For_All_Projects (Project, In_Tree, Dummy, Imported_First => True);
Last_Linker_Option := 0;
......@@ -974,7 +981,7 @@ package body Makeutl is
begin
Options := Linker_Opts.Table (Index).Options;
while Options /= Nil_String loop
Option := In_Tree.String_Elements.Table (Options).Value;
Option := In_Tree.Shared.String_Elements.Table (Options).Value;
Get_Name_String (Option);
-- Do not consider empty linker options
......@@ -991,7 +998,7 @@ package body Makeutl is
Including_L_Switch => True);
end if;
Options := In_Tree.String_Elements.Table (Options).Next;
Options := In_Tree.Shared.String_Elements.Table (Options).Next;
end loop;
end;
end loop;
......
gcc/ada/makeutl.ads
......@@ -40,7 +40,8 @@ package Makeutl is
-- Failing procedure called from procedure Test_If_Relative_Path below. May
-- be redirected.
Project_Tree : constant Project_Tree_Ref := new Project_Tree_Data;
Project_Tree : constant Project_Tree_Ref :=
new Project_Tree_Data (Is_Root_Tree => True);
-- The project tree
Source_Info_Option : constant String := "--source-info=";
......
gcc/ada/mlib-prj.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2010, AdaCore --
-- Copyright (C) 2001-2011, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -901,7 +901,7 @@ package body MLib.Prj is
Value_Of
(Name => Name_Binder,
In_Packages => For_Project.Decl.Packages,
In_Tree => In_Tree);
Shared => In_Tree.Shared);
begin
if Binder_Package /= No_Package then
......@@ -910,9 +910,9 @@ package body MLib.Prj is
Value_Of
(Name => Name_Default_Switches,
In_Arrays =>
In_Tree.Packages.Table
In_Tree.Shared.Packages.Table
(Binder_Package).Decl.Arrays,
In_Tree => In_Tree);
Shared => In_Tree.Shared);
Switches : Variable_Value := Nil_Variable_Value;
Switch : String_List_Id := Nil_String;
......@@ -924,7 +924,7 @@ package body MLib.Prj is
(Index => Name_Ada,
Src_Index => 0,
In_Array => Defaults,
In_Tree => In_Tree);
Shared => In_Tree.Shared);
if not Switches.Default then
Switch := Switches.Values;
......@@ -932,9 +932,9 @@ package body MLib.Prj is
while Switch /= Nil_String loop
Add_Argument
(Get_Name_String
(In_Tree.String_Elements.Table
(In_Tree.Shared.String_Elements.Table
(Switch).Value));
Switch := In_Tree.String_Elements.
Switch := In_Tree.Shared.String_Elements.
Table (Switch).Next;
end loop;
end if;
......@@ -1277,7 +1277,8 @@ package body MLib.Prj is
-- If attribute Library_Options was specified, add these options
Library_Options := Value_Of
(Name_Library_Options, For_Project.Decl.Attributes, In_Tree);
(Name_Library_Options, For_Project.Decl.Attributes,
In_Tree.Shared);
if not Library_Options.Default then
declare
......@@ -1287,7 +1288,7 @@ package body MLib.Prj is
begin
Current := Library_Options.Values;
while Current /= Nil_String loop
Element := In_Tree.String_Elements.Table (Current);
Element := In_Tree.Shared.String_Elements.Table (Current);
Get_Name_String (Element.Value);
if Name_Len /= 0 then
......@@ -1756,12 +1757,12 @@ package body MLib.Prj is
while Iface /= Nil_String loop
ALI :=
File_Name_Type
(In_Tree.String_Elements.Table (Iface).Value);
(In_Tree.Shared.String_Elements.Table (Iface).Value);
Interface_ALIs.Set (ALI, True);
Get_Name_String
(In_Tree.String_Elements.Table (Iface).Value);
(In_Tree.Shared.String_Elements.Table (Iface).Value);
Add_Argument (Name_Buffer (1 .. Name_Len));
Iface := In_Tree.String_Elements.Table (Iface).Next;
Iface := In_Tree.Shared.String_Elements.Table (Iface).Next;
end loop;
Iface := For_Project.Lib_Interface_ALIs;
......@@ -1775,9 +1776,10 @@ package body MLib.Prj is
while Iface /= Nil_String loop
ALI :=
File_Name_Type
(In_Tree.String_Elements.Table (Iface).Value);
(In_Tree.Shared.String_Elements.Table (Iface).Value);
Process (ALI);
Iface := In_Tree.String_Elements.Table (Iface).Next;
Iface :=
In_Tree.Shared.String_Elements.Table (Iface).Next;
end loop;
end if;
end;
......
gcc/ada/prj-conf.ads
......@@ -162,17 +162,6 @@ package Prj.Conf is
-- processed (and Packages_To_Check is used to indicate which packages
-- should be processed)
procedure Apply_Config_File
(Config_File : Prj.Project_Id;
Project_Tree : Prj.Project_Tree_Ref);
-- Apply the configuration file settings to all the projects in the
-- project tree. The Project_Tree must have been parsed first, and
-- processed through the first phase so that all its projects are known.
--
-- Currently, this will add new attributes and packages in the various
-- projects, so that when the second phase of the processing is performed
-- these attributes are automatically taken into account.
procedure Add_Default_GNAT_Naming_Scheme
(Config_File : in out Prj.Tree.Project_Node_Id;
Project_Tree : Prj.Tree.Project_Node_Tree_Ref);
......
gcc/ada/prj-env.ads
......@@ -88,6 +88,7 @@ package Prj.Env is
function Ada_Objects_Path
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Including_Libraries : Boolean := True) return String_Access;
-- Get the ADA_OBJECTS_PATH of a Project file. For the first call, compute
-- it and cache it. When Including_Libraries is False, do not include the
......@@ -149,7 +150,9 @@ package Prj.Env is
generic
with procedure Action (Path : String);
procedure For_All_Object_Dirs (Project : Project_Id);
procedure For_All_Object_Dirs
(Project : Project_Id;
Tree : Project_Tree_Ref);
-- Iterate through all the object directories of a project, including those
-- of imported or modified projects.
......
gcc/ada/prj-proc.ads
......@@ -72,7 +72,7 @@ package Prj.Proc is
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
Env : in out Prj.Tree.Environment;
Reset_Tree : Boolean := True);
Reset_Tree : Boolean := True);
-- Performs the two phases of the processing
end Prj.Proc;
gcc/ada/prj-util.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2010, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2011, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -29,7 +29,7 @@ package Prj.Util is
function Executable_Of
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Shared : Shared_Project_Tree_Data_Access;
Main : File_Name_Type;
Index : Int;
Ada_Main : Boolean := True;
......@@ -61,7 +61,7 @@ package Prj.Util is
procedure Duplicate
(This : in out Name_List_Index;
In_Tree : Project_Tree_Ref);
Shared : Shared_Project_Tree_Data_Access);
-- Duplicate a name list
function Value_Of
......@@ -73,7 +73,7 @@ package Prj.Util is
function Value_Of
(Index : Name_Id;
In_Array : Array_Element_Id;
In_Tree : Project_Tree_Ref) return Name_Id;
Shared : Shared_Project_Tree_Data_Access) return Name_Id;
-- Get a single string array component. Returns No_Name if there is no
-- component Index, if In_Array is null, or if the component is a String
-- list. Depending on the attribute (only attributes may be associative
......@@ -85,7 +85,7 @@ package Prj.Util is
(Index : Name_Id;
Src_Index : Int := 0;
In_Array : Array_Element_Id;
In_Tree : Project_Tree_Ref;
Shared : Shared_Project_Tree_Data_Access;
Force_Lower_Case_Index : Boolean := False;
Allow_Wildcards : Boolean := False) return Variable_Value;
-- Get a string array component (single String or String list). Returns
......@@ -101,7 +101,7 @@ package Prj.Util is
Index : Int := 0;
Attribute_Or_Array_Name : Name_Id;
In_Package : Package_Id;
In_Tree : Project_Tree_Ref;
Shared : Shared_Project_Tree_Data_Access;
Force_Lower_Case_Index : Boolean := False;
Allow_Wildcards : Boolean := False) return Variable_Value;
-- In a specific package:
......@@ -117,7 +117,7 @@ package Prj.Util is
(Index : Name_Id;
In_Array : Name_Id;
In_Arrays : Array_Id;
In_Tree : Project_Tree_Ref) return Name_Id;
Shared : Shared_Project_Tree_Data_Access) return Name_Id;
-- Get a string array component in an array of an array list. Returns
-- No_Name if there is no component Index, if In_Arrays is null, if
-- In_Array is not found in In_Arrays or if the component is a String list.
......@@ -125,7 +125,7 @@ package Prj.Util is
function Value_Of
(Name : Name_Id;
In_Arrays : Array_Id;
In_Tree : Project_Tree_Ref) return Array_Element_Id;
Shared : Shared_Project_Tree_Data_Access) return Array_Element_Id;
-- Returns a specified array in an array list. Returns No_Array_Element
-- if In_Arrays is null or if Name is not the name of an array in
-- In_Arrays. The caller must ensure that Name is in lower case.
......@@ -133,7 +133,7 @@ package Prj.Util is
function Value_Of
(Name : Name_Id;
In_Packages : Package_Id;
In_Tree : Project_Tree_Ref) return Package_Id;
Shared : Shared_Project_Tree_Data_Access) return Package_Id;
-- Returns a specified package in a package list. Returns No_Package
-- if In_Packages is null or if Name is not the name of a package in
-- Package_List. The caller must ensure that Name is in lower case.
......@@ -141,7 +141,7 @@ package Prj.Util is
function Value_Of
(Variable_Name : Name_Id;
In_Variables : Variable_Id;
In_Tree : Project_Tree_Ref) return Variable_Value;
Shared : Shared_Project_Tree_Data_Access) return Variable_Value;
-- Returns a specified variable in a variable list. Returns null if
-- In_Variables is null or if Variable_Name is not the name of a
-- variable in In_Variables. Caller must ensure that Name is lower case.
......
gcc/ada/prj.adb
......@@ -404,6 +404,7 @@ package body Prj is
procedure For_Every_Project_Imported
(By : Project_Id;
Tree : Project_Tree_Ref;
With_State : in out State;
Include_Aggregated : Boolean := True;
Imported_First : Boolean := False)
......@@ -411,7 +412,8 @@ package body Prj is
use Project_Boolean_Htable;
Seen : Project_Boolean_Htable.Instance := Project_Boolean_Htable.Nil;
procedure Recursive_Check (Project : Project_Id);
procedure Recursive_Check
(Project : Project_Id; Tree : Project_Tree_Ref);
-- Check if a project has already been seen. If not seen, mark it as
-- Seen, Call Action, and check all its imported projects.
......@@ -419,29 +421,34 @@ package body Prj is
-- Recursive_Check --
---------------------
procedure Recursive_Check (Project : Project_Id) is
procedure Recursive_Check
(Project : Project_Id; Tree : Project_Tree_Ref)
is
List : Project_List;
Agg : Aggregated_Project_List;
begin
if not Get (Seen, Project) then
-- Even if a project is aggregated multiple times, we will only
-- return it once.
Set (Seen, Project, True);
if not Imported_First then
Action (Project, With_State);
Action (Project, Tree, With_State);
end if;
-- Visit all extended projects
if Project.Extends /= No_Project then
Recursive_Check (Project.Extends);
Recursive_Check (Project.Extends, Tree);
end if;
-- Visit all imported projects
List := Project.Imported_Projects;
while List /= null loop
Recursive_Check (List.Project);
Recursive_Check (List.Project, Tree);
List := List.Next;
end loop;
......@@ -453,13 +460,13 @@ package body Prj is
Agg := Project.Aggregated_Projects;
while Agg /= null loop
pragma Assert (Agg.Project /= No_Project);
Recursive_Check (Agg.Project);
Recursive_Check (Agg.Project, Agg.Tree);
Agg := Agg.Next;
end loop;
end if;
if Imported_First then
Action (Project, With_State);
Action (Project, Tree, With_State);
end if;
end if;
end Recursive_Check;
......@@ -467,7 +474,7 @@ package body Prj is
-- Start of processing for For_Every_Project_Imported
begin
Recursive_Check (Project => By);
Recursive_Check (Project => By, Tree => Tree);
Reset (Seen);
end For_Every_Project_Imported;
......@@ -484,18 +491,25 @@ package body Prj is
is
Result : Source_Id := No_Source;
procedure Look_For_Sources (Proj : Project_Id; Src : in out Source_Id);
procedure Look_For_Sources
(Proj : Project_Id;
Tree : Project_Tree_Ref;
Src : in out Source_Id);
-- Look for Base_Name in the sources of Proj
----------------------
-- Look_For_Sources --
----------------------
procedure Look_For_Sources (Proj : Project_Id; Src : in out Source_Id) is
procedure Look_For_Sources
(Proj : Project_Id;
Tree : Project_Tree_Ref;
Src : in out Source_Id)
is
Iterator : Source_Iterator;
begin
Iterator := For_Each_Source (In_Tree => In_Tree, Project => Proj);
Iterator := For_Each_Source (In_Tree => Tree, Project => Proj);
while Element (Iterator) /= No_Source loop
if Element (Iterator).File = Base_Name then
Src := Element (Iterator);
......@@ -517,22 +531,23 @@ package body Prj is
if In_Extended_Only then
Proj := Project;
while Proj /= No_Project loop
Look_For_Sources (Proj, Result);
Look_For_Sources (Proj, In_Tree, Result);
exit when Result /= No_Source;
Proj := Proj.Extends;
end loop;
elsif In_Imported_Only then
Look_For_Sources (Project, Result);
Look_For_Sources (Project, In_Tree, Result);
if Result = No_Source then
For_Imported_Projects
(By => Project,
Tree => In_Tree,
With_State => Result);
end if;
else
Look_For_Sources (No_Project, Result);
Look_For_Sources (No_Project, In_Tree, Result);
end if;
return Result;
......@@ -604,12 +619,9 @@ package body Prj is
Prj.Attr.Initialize;
Set_Name_Table_Byte
(Name_Project, Token_Type'Pos (Tok_Project));
Set_Name_Table_Byte
(Name_Extends, Token_Type'Pos (Tok_Extends));
Set_Name_Table_Byte
(Name_External, Token_Type'Pos (Tok_External));
Set_Name_Table_Byte (Name_Project, Token_Type'Pos (Tok_Project));
Set_Name_Table_Byte (Name_Extends, Token_Type'Pos (Tok_Extends));
Set_Name_Table_Byte (Name_External, Token_Type'Pos (Tok_External));
Set_Name_Table_Byte
(Name_External_As_List, Token_Type'Pos (Tok_External_As_List));
end if;
......@@ -716,6 +728,9 @@ package body Prj is
begin
while List /= null loop
Tmp := List.Next;
Free (List.Tree);
Unchecked_Free (List);
List := Tmp;
end loop;
......@@ -731,6 +746,7 @@ package body Prj is
Project.Aggregated_Projects := new Aggregated_Project'
(Path => Path,
Project => No_Project,
Tree => null,
Next => Project.Aggregated_Projects);
end Add_Aggregated_Project;
......@@ -888,13 +904,16 @@ package body Prj is
begin
if Tree /= null then
Name_List_Table.Free (Tree.Name_Lists);
Number_List_Table.Free (Tree.Number_Lists);
String_Element_Table.Free (Tree.String_Elements);
Variable_Element_Table.Free (Tree.Variable_Elements);
Array_Element_Table.Free (Tree.Array_Elements);
Array_Table.Free (Tree.Arrays);
Package_Table.Free (Tree.Packages);
if Tree.Is_Root_Tree then
Name_List_Table.Free (Tree.Shared.Name_Lists);
Number_List_Table.Free (Tree.Shared.Number_Lists);
String_Element_Table.Free (Tree.Shared.String_Elements);
Variable_Element_Table.Free (Tree.Shared.Variable_Elements);
Array_Element_Table.Free (Tree.Shared.Array_Elements);
Array_Table.Free (Tree.Shared.Arrays);
Package_Table.Free (Tree.Shared.Packages);
end if;
Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
Source_Files_Htable.Reset (Tree.Source_Files_HT);
......@@ -917,13 +936,21 @@ package body Prj is
begin
-- Visible tables
Name_List_Table.Init (Tree.Name_Lists);
Number_List_Table.Init (Tree.Number_Lists);
String_Element_Table.Init (Tree.String_Elements);
Variable_Element_Table.Init (Tree.Variable_Elements);
Array_Element_Table.Init (Tree.Array_Elements);
Array_Table.Init (Tree.Arrays);
Package_Table.Init (Tree.Packages);
if Tree.Is_Root_Tree then
-- We cannot use 'Access here:
-- "illegal attribute for discriminant-dependent component"
-- However, we know this is valid since Shared and Shared_Data have
-- the same lifetime and will always exist concurrently.
Tree.Shared := Tree.Shared_Data'Unrestricted_Access;
Name_List_Table.Init (Tree.Shared.Name_Lists);
Number_List_Table.Init (Tree.Shared.Number_Lists);
String_Element_Table.Init (Tree.Shared.String_Elements);
Variable_Element_Table.Init (Tree.Shared.Variable_Elements);
Array_Element_Table.Init (Tree.Shared.Array_Elements);
Array_Table.Init (Tree.Shared.Arrays);
Package_Table.Init (Tree.Shared.Packages);
end if;
Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
Source_Files_Htable.Reset (Tree.Source_Files_HT);
Replaced_Source_HTable.Reset (Tree.Replaced_Sources);
......@@ -1110,7 +1137,10 @@ package body Prj is
procedure Compute_All_Imported_Projects (Tree : Project_Tree_Ref) is
Project : Project_Id;
procedure Recursive_Add (Prj : Project_Id; Dummy : in out Boolean);
procedure Recursive_Add
(Prj : Project_Id;
Tree : Project_Tree_Ref;
Dummy : in out Boolean);
-- Recursively add the projects imported by project Project, but not
-- those that are extended.
......@@ -1118,8 +1148,12 @@ package body Prj is
-- Recursive_Add --
-------------------
procedure Recursive_Add (Prj : Project_Id; Dummy : in out Boolean) is
pragma Unreferenced (Dummy);
procedure Recursive_Add
(Prj : Project_Id;
Tree : Project_Tree_Ref;
Dummy : in out Boolean)
is
pragma Unreferenced (Dummy, Tree);
List : Project_List;
Prj2 : Project_Id;
......@@ -1163,7 +1197,7 @@ package body Prj is
while List /= null loop
Project := List.Project;
Free_List (Project.All_Imported_Projects, Free_Project => False);
For_All_Projects (Project, Dummy);
For_All_Projects (Project, Tree, Dummy, Include_Aggregated => False);
List := List.Next;
end loop;
end Compute_All_Imported_Projects;
......
gcc/ada/prj.ads
......@@ -1094,6 +1094,7 @@ package Prj is
type Aggregated_Project_List is access all Aggregated_Project;
type Aggregated_Project is record
Path : Path_Name_Type;
Tree : Project_Tree_Ref;
Project : Project_Id;
Next : Aggregated_Project_List;
end record;
......@@ -1400,41 +1401,68 @@ package Prj is
type Private_Project_Tree_Data is private;
-- Data for a project tree that is used only by the Project Manager
type Project_Tree_Data is
record
Name_Lists : Name_List_Table.Instance;
Number_Lists : Number_List_Table.Instance;
String_Elements : String_Element_Table.Instance;
Variable_Elements : Variable_Element_Table.Instance;
Array_Elements : Array_Element_Table.Instance;
Arrays : Array_Table.Instance;
Packages : Package_Table.Instance;
Projects : Project_List;
type Shared_Project_Tree_Data is record
Name_Lists : Name_List_Table.Instance;
Number_Lists : Number_List_Table.Instance;
String_Elements : String_Element_Table.Instance;
Variable_Elements : Variable_Element_Table.Instance;
Array_Elements : Array_Element_Table.Instance;
Arrays : Array_Table.Instance;
Packages : Package_Table.Instance;
end record;
type Shared_Project_Tree_Data_Access is access all Shared_Project_Tree_Data;
-- The data that is shared among multiple trees, when these trees are
-- loaded through the same aggregate project.
-- To avoid ambiguities, limit the number of parameters to the
-- subprograms (we would have to parse the "root project tree" since this
-- is where the configuration file was loaded, in addition to the project's
-- own tree) and make the comparison of projects easier, all trees store
-- the lists in the same tables.
type Project_Tree_Data (Is_Root_Tree : Boolean := True) is record
-- The root tree is the one loaded by the user from the command line.
-- Is_Root_Tree is only false for projects aggregated within a root
-- aggregate project.
Projects : Project_List;
-- List of projects in this tree
Replaced_Sources : Replaced_Source_HTable.Instance;
-- The list of sources that have been replaced by sources with
-- different file names.
Replaced_Source_Number : Natural := 0;
-- The number of entries in Replaced_Sources
Replaced_Sources : Replaced_Source_HTable.Instance;
-- The list of sources that have been replaced by sources with
-- different file names.
Units_HT : Units_Htable.Instance;
-- Unit name to Unit_Index (and from there to Source_Id)
Replaced_Source_Number : Natural := 0;
-- The number of entries in Replaced_Sources
Source_Files_HT : Source_Files_Htable.Instance;
-- Base source file names to Source_Id list.
Units_HT : Units_Htable.Instance;
-- Unit name to Unit_Index (and from there to Source_Id)
Source_Paths_HT : Source_Paths_Htable.Instance;
-- Full path to Source_Id
Source_Files_HT : Source_Files_Htable.Instance;
-- Base source file names to Source_Id list.
Source_Info_File_Name : String_Access := null;
-- The name of the source info file, if specified by the builder
Source_Paths_HT : Source_Paths_Htable.Instance;
-- Full path to Source_Id
Source_Info_File_Exists : Boolean := False;
-- True when a source info file has been successfully read
Source_Info_File_Name : String_Access := null;
-- The name of the source info file, if specified by the builder
Private_Part : Private_Project_Tree_Data;
Source_Info_File_Exists : Boolean := False;
-- True when a source info file has been successfully read
Shared : Shared_Project_Tree_Data_Access;
-- The shared data for this tree and all aggregated trees.
Private_Part : Private_Project_Tree_Data;
end record;
case Is_Root_Tree is
when True =>
Shared_Data : aliased Shared_Project_Tree_Data;
-- Do not access directly, only through Shared.
when False =>
null;
end case;
end record;
-- Data for a project tree
procedure Expect (The_Token : Token_Type; Token_Image : String);
......@@ -1463,9 +1491,11 @@ package Prj is
type State is limited private;
with procedure Action
(Project : Project_Id;
Tree : Project_Tree_Ref;
With_State : in out State);
procedure For_Every_Project_Imported
(By : Project_Id;
Tree : Project_Tree_Ref;
With_State : in out State;
Include_Aggregated : Boolean := True;
Imported_First : Boolean := False);
......@@ -1488,6 +1518,9 @@ package Prj is
-- If Include_Aggregated is True, then an aggregate project will recurse
-- into the projects it aggregates. Otherwise, the latter are never
-- returned
--
-- The Tree argument passed to the callback is required in the case of
-- aggregated projects, since they might not be using the same tree as 'By'
function Extend_Name
(File : File_Name_Type;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment