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

* prj.adb, prj.ads, makeutl.adb, makeutl.ads, prj-env.adb
	(Project_Tree_Appdata): New type.
	It is now possible to associate application-specific data to a project
	tree. In particular, this is used in the gprbuild builder to avoid a
	number of global tables and htables, especially now that there can be
	several project trees loaded at once because of aggregate projects.
	(Debug_Name): new procedure.
	* projects.texi: Clarify syntax of "**" for Source_Dirs

From-SVN: r177315
This commit is contained in:
Emmanuel Briot 2011-08-04 07:40:11 +00:00 committed by Arnaud Charlet
parent 6eb9142a25
commit 9434c32ec6
7 changed files with 93 additions and 11 deletions

View File

@ -1,3 +1,14 @@
2011-08-04 Emmanuel Briot <briot@adacore.com>
* prj.adb, prj.ads, makeutl.adb, makeutl.ads, prj-env.adb
(Project_Tree_Appdata): New type.
It is now possible to associate application-specific data to a project
tree. In particular, this is used in the gprbuild builder to avoid a
number of global tables and htables, especially now that there can be
several project trees loaded at once because of aggregate projects.
(Debug_Name): new procedure.
* projects.texi: Clarify syntax of "**" for Source_Dirs
2011-08-03 Emmanuel Briot <briot@adacore.com>
* prj.ads, makeutl.adb, makeutl.ads (Queue.Insert): now also inserts

View File

@ -33,13 +33,13 @@ with Osint; use Osint;
with Output; use Output;
with Opt; use Opt;
with Prj.Ext;
with Prj.Util;
with Prj.Util; use Prj.Util;
with Sinput.P;
with Snames; use Snames;
with Table;
with Tempdir;
with Ada.Command_Line; use Ada.Command_Line;
with Ada.Command_Line; use Ada.Command_Line;
with GNAT.Case_Util; use GNAT.Case_Util;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
@ -2478,7 +2478,6 @@ package body Makeutl is
end loop;
end loop;
end Insert_Withed_Sources_For;
end Queue;
end Makeutl;

View File

@ -41,6 +41,9 @@ package Makeutl is
type Fail_Proc is access procedure (S : String);
On_Windows : constant Boolean := Directory_Separator = '\';
-- True when on Windows
Source_Info_Option : constant String := "--source-info=";
-- Switch to indicate the source info file
@ -337,6 +340,9 @@ package Makeutl is
-- depends on the builder, and in particular whether it only supports
-- project-based files (in which case we have a full Source_Id record).
No_Source_Info : constant Source_Info :=
(Format_Gprbuild, null, null);
procedure Initialize
(Queue_Per_Obj_Dir : Boolean;
Force : Boolean := False);

View File

@ -829,6 +829,7 @@ package body Prj.Env is
Iter : Source_Iterator;
begin
Debug_Output ("Add mapping for project", Project.Name);
Iter := For_Each_Source (In_Tree, Project, Language => Language);
loop
@ -901,13 +902,18 @@ package body Prj.Env is
-- Start of processing for Create_Mapping_File
begin
if Current_Verbosity = High then
Debug_Output ("Create mapping file for", Debug_Name (In_Tree));
end if;
Create_Temp_File (In_Tree.Shared, File, Name, "mapping");
if Current_Verbosity = High then
Debug_Increase_Indent ("Create mapping file ", Name_Id (Name));
end if;
For_Every_Imported_Project (Project, In_Tree, Dummy);
For_Every_Imported_Project
(Project, In_Tree, Dummy, Include_Aggregated => False);
declare
Last : Natural;

View File

@ -943,6 +943,8 @@ package body Prj is
procedure Free (Tree : in out Project_Tree_Ref) is
procedure Unchecked_Free is new
Ada.Unchecked_Deallocation (Project_Tree_Data, Project_Tree_Ref);
procedure Unchecked_Free is new Ada.Unchecked_Deallocation
(Project_Tree_Appdata'Class, Project_Tree_Appdata_Access);
begin
if Tree /= null then
@ -957,6 +959,11 @@ package body Prj is
Temp_Files_Table.Free (Tree.Shared.Private_Part.Temp_Files);
end if;
if Tree.Appdata /= null then
Free (Tree.Appdata.all);
Unchecked_Free (Tree.Appdata);
end if;
Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
Source_Files_Htable.Reset (Tree.Source_Files_HT);
@ -1466,6 +1473,41 @@ package body Prj is
end if;
end Debug_Decrease_Indent;
----------------
-- Debug_Name --
----------------
function Debug_Name (Tree : Project_Tree_Ref) return Name_Id is
P : Project_List := Tree.Projects;
begin
Name_Len := 0;
Add_Str_To_Name_Buffer ("Tree [");
while P /= null loop
if P /= Tree.Projects then
Add_Char_To_Name_Buffer (',');
end if;
Add_Str_To_Name_Buffer (Get_Name_String (P.Project.Name));
P := P.Next;
end loop;
Add_Char_To_Name_Buffer (']');
return Name_Find;
end Debug_Name;
----------
-- Free --
----------
procedure Free (Tree : in out Project_Tree_Appdata) is
pragma Unreferenced (Tree);
begin
null;
end Free;
begin
-- Make sure that the standard config and user project file extensions are
-- compatible with canonical case file naming.

View File

@ -1437,6 +1437,17 @@ package Prj is
-- own tree) and make the comparison of projects easier, all trees store
-- the lists in the same tables.
type Project_Tree_Appdata is tagged null record;
type Project_Tree_Appdata_Access is access all Project_Tree_Appdata'Class;
-- Application-specific data that can be associated with a project tree.
-- We do not make the Project_Tree_Data itself tagged for several reasons:
-- - it couldn't have a default value for its discriminant
-- - it would require a "factory" to allocate such data, because trees
-- are created automatically when parsing aggregate projects.
procedure Free (Tree : in out Project_Tree_Appdata);
-- Should be overridden if your derive your own data
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
@ -1472,6 +1483,9 @@ package Prj is
Shared : Shared_Project_Tree_Data_Access;
-- The shared data for this tree and all aggregated trees.
Appdata : Project_Tree_Appdata_Access;
-- Application-specific data for this tree
case Is_Root_Tree is
when True =>
Shared_Data : aliased Shared_Project_Tree_Data;
@ -1483,6 +1497,10 @@ package Prj is
end record;
-- Data for a project tree
function Debug_Name (Tree : Project_Tree_Ref) return Name_Id;
-- If debug traces are activated, return an identitier for the
-- project tree. This modifies Name_Buffer
procedure Expect (The_Token : Token_Type; Token_Image : String);
-- Check that the current token is The_Token. If it is not, then output
-- an error message.

View File

@ -266,9 +266,9 @@ There are several ways of defining source directories:
@item The attribute @b{Source_Dirs} can automatically include subdirectories
using a special syntax inspired by some UNIX shells. If any of the path in
the list ends with @emph{"/**"}, then that path and all its subdirectories
the list ends with @emph{"**"}, then that path and all its subdirectories
(recursively) are included in the list of source directories. For instance,
@file{./**} represent the complete directory tree rooted at ".".
@file{**} and @file{./**} represent the complete directory tree rooted at ".".
@cindex Source directories, recursive
@cindex @code{Excluded_Source_Dirs}
@ -276,7 +276,7 @@ There are several ways of defining source directories:
attribute @b{Excluded_Source_Dirs}, which is also a list of paths. Each entry
specifies a directory whose immediate content, not including subdirs, is to
be excluded. It is also possible to exclude a complete directory subtree
using the "/**" notation.
using the "**" notation.
@cindex @code{Ignore_Source_Sub_Dirs}
It is often desirable to remove, from the source directories, directory
@ -396,13 +396,13 @@ Note that it is considered an error for a project file to have no sources
attached to it unless explicitly declared as mentioned above.
If the order of the source directories is known statically, that is if
@code{"/**"} is not used in the string list @code{Source_Dirs}, then there may
@code{"**"} is not used in the string list @code{Source_Dirs}, then there may
be several files with the same source file name sitting in different
directories of the project. In this case, only the file in the first directory
is considered as a source of the project and the others are hidden. If
@code{"/**"} is not used in the string list @code{Source_Dirs}, it is an error
@code{"**"} is not used in the string list @code{Source_Dirs}, it is an error
to have several files with the same source file name in the same directory
@code{"/**"} subtree, since there would be an ambiguity as to which one should
@code{"**"} subtree, since there would be an ambiguity as to which one should
be used. However, two files with the same source file name may in two single
directories or directory subtrees. In this case, the one in the first directory
or directory subtree is a source of the project.
@ -3727,7 +3727,7 @@ is specified for the source file.
@group
project Proj is
for Source_Dirs use ("./**");
for Source_Dirs use ("**");
package gnatls is
for Switches use