2011-08-04 Emmanuel Briot <briot@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 4 Aug 2011 07:40:11 +0000 (07:40 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 4 Aug 2011 07:40:11 +0000 (07:40 +0000)
* 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

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@177315 138bc75d-0d04-0410-961f-82ee72b054a4

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 574ed80..51d25ff 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 c8c9aef..44575ba 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 43f82e2..428d34f 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 58f1ec8..e91bf61 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 7640bcf..05163c3 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 578faf2..4d8e470 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 7884459..3d7e597 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