Skip to content

Commit

Permalink
Merge branch 'mr/jicquel/#89.aggregate-library-projects-iterator' int…
Browse files Browse the repository at this point in the history
…o 'master'

Iterate over aggregated library projects

See merge request eng/toolchain/gnatcoll-core!151
  • Loading branch information
Jicquel committed Nov 18, 2024
2 parents da6ffd8 + b3ceb7b commit 1d8d407
Show file tree
Hide file tree
Showing 8 changed files with 142 additions and 13 deletions.
28 changes: 20 additions & 8 deletions projects/src/gnatcoll-projects.adb
Original file line number Diff line number Diff line change
@@ -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 --
Expand Down Expand Up @@ -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;

Expand Down Expand Up @@ -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;
Expand Down
14 changes: 9 additions & 5 deletions projects/src/gnatcoll-projects.ads
Original file line number Diff line number Diff line change
@@ -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 --
Expand Down Expand Up @@ -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
Expand All @@ -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.

Expand Down
Original file line number Diff line number Diff line change
@@ -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;
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
description: Check aggregated libraries project iteration.
data:
- "tree"
- "test.adb"
Original file line number Diff line number Diff line change
@@ -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;
Original file line number Diff line number Diff line change
@@ -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;
Original file line number Diff line number Diff line change
@@ -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;
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
with "./agg.gpr";

project Root is

end Root;

0 comments on commit 1d8d407

Please sign in to comment.