2011-08-04 Emmanuel Briot <briot@adacore.com>
authorEmmanuel Briot <briot@adacore.com>
Thu, 4 Aug 2011 07:40:11 +0000 (07:40 +0000)
committerArnaud Charlet <charlet@gcc.gnu.org>
Thu, 4 Aug 2011 07:40:11 +0000 (09:40 +0200)
* 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

gcc/ada/ChangeLog
gcc/ada/makeutl.adb
gcc/ada/makeutl.ads
gcc/ada/prj-env.adb
gcc/ada/prj.adb
gcc/ada/prj.ads
gcc/ada/projects.texi

index 574ed80b5b76325358671ced604dff767d6fd3a3..51d25ff70619923d15794169f043e76eef9c3230 100644 (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
index c8c9aefdf3ca2ba4505969a400e69e5ddb0e6577..44575ba29e72ee48c61624d996e9b51e5019afe8 100644 (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;
index 43f82e20c59f8b10ab8ed36cd9173a6786d668fe..428d34fa29114a1f224bebb52a3bad54dc3e6056 100644 (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);
index 58f1ec8c57f09958e4e28b5bfd515bf197ff02a3..e91bf61e2818c87aef7f51ff8f1c29b67570b987 100644 (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;
index 7640bcfcdbb140192cfb0ffce1f951781c259ab4..05163c3faaa67510f667449b57f942def12b305f 100644 (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.
index 578faf2659b1934eb70b47d5096a63663f79d365..4d8e47030b3643274a88311d391dd3c80d5f0567 100644 (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.
index 788445914fa72ea02d7d759e69f7a4383b1ec2a7..3d7e59706c26e7b1ef330faa3783a2edb9cd125d 100644 (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