Merge branch 'mr/jicquel/#89.iterate-aggregate-lib' into '25.1'

Iterate over aggregated library projects

See merge request eng/toolchain/gnatcoll-core!154

projects/src/gnatcoll-projects.adb

@@ -1,7 +1,7 @@
 ------------------------------------------------------------------------------
 --                             G N A T C O L L                              --
 --                                                                          --
---                     Copyright (C) 2002-2022, AdaCore                     --
+--                     Copyright (C) 2002-2024, AdaCore                     --
 --                                                                          --
 -- This library is free software;  you can redistribute it and/or modify it --
 -- under terms of the  GNU General Public License  as published by the Free --
@@ -4353,10 +4353,11 @@ package body GNATCOLL.Projects is
    -----------
 
    function Start
-     (Root_Project       : Project_Type;
-      Recursive          : Boolean := True;
-      Direct_Only        : Boolean := False;
-      Include_Extended   : Boolean := True) return Project_Iterator
+     (Root_Project                : Project_Type;
+      Recursive                   : Boolean := True;
+      Direct_Only                 : Boolean := False;
+      Include_Extended            : Boolean := True;
+      Include_Aggregate_Libraries : Boolean := False) return Project_Iterator
    is
       Iter       : Project_Iterator;
 
@@ -4429,9 +4430,20 @@ package body GNATCOLL.Projects is
             then
                Project_Paths.Include (P.Project_Path.Display_Full_Name);
 
-               if Is_Aggregate_Project (P) and then not Direct_Only then
-                  --  aggregate library
-                  Add_Project (P);
+               if Is_Aggregate_Project (P) then
+
+               --  ??? Direct_Only should not impact aggregates as it only
+               --- concerns imports.
+
+                  if not Direct_Only then
+                     Add_Project (P);
+                  end if;
+
+                  if Is_Aggregate_Library (P)
+                    and then Include_Aggregate_Libraries
+                  then
+                     Iter.Project_List.Append (P);
+                  end if;
                else
                   Iter.Project_List.Append (P);
                end if;

projects/src/gnatcoll-projects.ads

@@ -1,7 +1,7 @@
 ------------------------------------------------------------------------------
 --                             G N A T C O L L                              --
 --                                                                          --
---                     Copyright (C) 2002-2022, AdaCore                     --
+--                     Copyright (C) 2002-2024, AdaCore                     --
 --                                                                          --
 -- This library is free software;  you can redistribute it and/or modify it --
 -- under terms of the  GNU General Public License  as published by the Free --
@@ -1161,10 +1161,11 @@ package GNATCOLL.Projects is
    --  projects.
 
    function Start
-     (Root_Project       : Project_Type;
-      Recursive          : Boolean := True;
-      Direct_Only        : Boolean := False;
-      Include_Extended   : Boolean := True) return Project_Iterator;
+     (Root_Project                : Project_Type;
+      Recursive                   : Boolean := True;
+      Direct_Only                 : Boolean := False;
+      Include_Extended            : Boolean := True;
+      Include_Aggregate_Libraries : Boolean := False) return Project_Iterator;
    pragma Precondition (Root_Project /= No_Project);
    --  Initialize the iterator to start at Root_Project.
    --  It will process Root_Project and all its subprojects, recursively, but
@@ -1187,6 +1188,9 @@ package GNATCOLL.Projects is
    --  Projects mentioned in a Project_Files attribute (aggregate project
    --  or library aggregate project) will also be returned (and their own
    --  dependencies recursively, if needed).
+
+   --  If Include_Aggregate_Libraries is True, library aggregate projects
+   --  are always returned.
    --
    --  Start should not be called before the view has been fully recomputed.
 

testsuite/tests/projects/aggregated_libraries/project_iterator/test.adb

@@ -0,0 +1,79 @@
+------------------------------------------------------------------------------
+--                             G N A T C O L L                              --
+--                                                                          --
+--                       Copyright (C) 2024, AdaCore                        --
+--                                                                          --
+-- This library is free software;  you can redistribute it and/or modify it --
+-- under terms of the  GNU General Public License  as published by the Free --
+-- Software  Foundation;  either version 3,  or (at your  option) any later --
+-- version. This library is distributed in the hope that it will be useful, --
+-- but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN- --
+-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE.                            --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+--  Test the aggregated libraries project iteration
+
+with GNATCOLL.Projects; use GNATCOLL.Projects;
+with GNATCOLL.VFS;      use GNATCOLL.VFS;
+with Test_Assert;       use Test_Assert;
+
+function Test return Integer is
+   PT : Project_Tree;
+   procedure Silent_Report (S : String) is null;
+
+   procedure Internal (Include_Aggregate_Libraries : Boolean);
+
+   procedure Internal (Include_Aggregate_Libraries : Boolean) is
+
+      Files      : File_Array (1 .. 4);
+      File_Index : Integer := 1;
+      It         : Project_Iterator :=
+        Start
+          (PT.Root_Project,
+           Include_Aggregate_Libraries => Include_Aggregate_Libraries);
+
+   begin
+      while Current (It) /= No_Project loop
+         Files (File_Index) := Current (It).Project_Path;
+         Next (It);
+         File_Index := File_Index + 1;
+      end loop;
+
+      if Include_Aggregate_Libraries then
+         Assert (File_Index = 5, "Check that we iterate over 4 projects");
+         Sort (Files);
+
+         Assert (Files (1).Display_Base_Name, "agg.gpr", "check 1st project");
+         Assert (Files (2).Display_Base_Name, "lib1.gpr", "check 2nd project");
+         Assert (Files (3).Display_Base_Name, "lib2.gpr", "check 3rd project");
+         Assert (Files (4).Display_Base_Name, "root.gpr", "check 4th project");
+      else
+         Assert (File_Index = 4, "Check that we iterate over 3 projects");
+         Sort (Files (1 .. 3));
+
+         Assert (Files (1).Display_Base_Name, "lib1.gpr", "check 1st project");
+         Assert (Files (2).Display_Base_Name, "lib2.gpr", "check 2rd project");
+         Assert (Files (3).Display_Base_Name, "root.gpr", "check 3rd project");
+      end if;
+   end Internal;
+
+begin
+   PT.Load
+     (Create ("tree/root.gpr"), Errors => Silent_Report'Unrestricted_Access);
+
+   Internal (True);
+   Internal (False);
+
+   PT.Unload;
+
+   return Test_Assert.Report;
+
+end Test;

testsuite/tests/projects/aggregated_libraries/project_iterator/test.yaml

@@ -0,0 +1,4 @@
+description: Check aggregated libraries project iteration.
+data:
+    - "tree"
+    - "test.adb"

testsuite/tests/projects/aggregated_libraries/project_iterator/tree/agg.gpr

@@ -0,0 +1,11 @@
+aggregate library project Agg is
+
+    for Project_Files use (
+        "./lib1.gpr",
+        "./lib2.gpr"
+    );
+
+    for Library_Dir use "lib_agg";
+    for Library_Name use "agg";
+
+end Agg;

testsuite/tests/projects/aggregated_libraries/project_iterator/tree/lib1.gpr

@@ -0,0 +1,7 @@
+library project Lib1 is
+
+    for Object_Dir use "obj_lib1";
+    for Library_Dir use "lib1";
+    for Library_Name use "lib1";
+
+end Lib1;

testsuite/tests/projects/aggregated_libraries/project_iterator/tree/lib2.gpr

@@ -0,0 +1,7 @@
+library project Lib2 is
+
+    for Object_Dir use "obj_lib2";
+    for Library_Dir use "lib2";
+    for Library_Name use "lib2";
+
+end Lib2;

testsuite/tests/projects/aggregated_libraries/project_iterator/tree/root.gpr

@@ -0,0 +1,5 @@
+with "./agg.gpr";
+
+project Root is
+
+end Root;