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:
parent
6eb9142a25
commit
9434c32ec6
@ -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
|
||||
|
@ -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;
|
||||
|
@ -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);
|
||||
|
@ -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;
|
||||
|
@ -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.
|
||||
|
@ -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.
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user