+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
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;
end loop;
end loop;
end Insert_Withed_Sources_For;
-
end Queue;
end Makeutl;
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
-- 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);
Iter : Source_Iterator;
begin
+ Debug_Output ("Add mapping for project", Project.Name);
Iter := For_Each_Source (In_Tree, Project, Language => Language);
loop
-- 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;
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
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);
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.
-- 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
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;
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.
@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}
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
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.
@group
project Proj is
- for Source_Dirs use ("./**");
+ for Source_Dirs use ("**");
package gnatls is
for Switches use