diff mbox

[Ada] New procedure to get a context while parsing a project tree

Message ID 20120208092920.GA2784@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet Feb. 8, 2012, 9:29 a.m. UTC 
No test as no change in behavior. This is for gprbuild.

Tested on x86_64-pc-linux-gnu, committed on trunk

2012-02-08  Pascal Obry  <obry@adacore.com>

	* prj.ads, prj.adb (For_Project_And_Aggregated_Context): New
	generic routine with a context parameter.
diff mbox

Patch

Index: prj.adb
===================================================================
--- prj.adb	(revision 183996)
+++ prj.adb	(working copy)
@@ -1863,6 +1863,56 @@ 
       end if;
    end For_Project_And_Aggregated;
 
+   ----------------------------------------
+   -- For_Project_And_Aggregated_Context --
+   ----------------------------------------
+
+   procedure For_Project_And_Aggregated_Context
+     (Root_Project : Project_Id;
+      Root_Tree    : Project_Tree_Ref)
+   is
+
+      procedure Recursive_Process
+        (Project : Project_Id;
+         Tree    : Project_Tree_Ref;
+         Context : Project_Context);
+      --  Process Project and all aggregated projects recursively
+
+      -----------------------
+      -- Recursive_Process --
+      -----------------------
+
+      procedure Recursive_Process
+        (Project : Project_Id;
+         Tree    : Project_Tree_Ref;
+         Context : Project_Context)
+      is
+         Agg : Aggregated_Project_List;
+         Ctx : Project_Context;
+      begin
+         Action (Project, Tree, Context);
+
+         if Project.Qualifier in Aggregate_Project then
+            Ctx :=
+              (In_Aggregate_Lib      => True,
+               From_Encapsulated_Lib =>
+                 Context.From_Encapsulated_Lib
+                   or else
+                 Project.Standalone_Library = Encapsulated);
+
+            Agg := Project.Aggregated_Projects;
+            while Agg /= null loop
+               Recursive_Process (Agg.Project, Agg.Tree, Ctx);
+               Agg := Agg.Next;
+            end loop;
+         end if;
+      end Recursive_Process;
+
+   begin
+      Recursive_Process
+        (Root_Project, Root_Tree, Project_Context'(False, False));
+   end For_Project_And_Aggregated_Context;
+
 --  Package initialization for Prj
 
 begin
Index: prj.ads
===================================================================
--- prj.ads	(revision 183996)
+++ prj.ads	(working copy)
@@ -1621,7 +1621,18 @@ 
       With_State         : in out State;
       Include_Aggregated : Boolean := True;
       Imported_First     : Boolean := False);
+   --  As above but with an associated context
 
+   generic
+      with procedure Action
+        (Project : Project_Id;
+         Tree    : Project_Tree_Ref;
+         Context : Project_Context);
+   procedure For_Project_And_Aggregated_Context
+     (Root_Project : Project_Id;
+      Root_Tree    : Project_Tree_Ref);
+   --  As above but with an associated context
+
    function Extend_Name
      (File        : File_Name_Type;
       With_Suffix : String) return File_Name_Type;