From 5d801d39fab0f6e2f08b8231198245031a7185a7 Mon Sep 17 00:00:00 2001 From: Vincent Jicquel Date: Tue, 29 Oct 2024 15:43:54 +0100 Subject: [PATCH] Iterate over aggregated library projects Add the Include_Aggregate_Libraries flag to the Start function of Project_Iterator. When this flag is set to True, the iterator will also include aggregated library projects. --- projects/src/gnatcoll-projects.adb | 28 +++++-- projects/src/gnatcoll-projects.ads | 14 ++-- .../project_iterator/test.adb | 79 +++++++++++++++++++ .../project_iterator/test.yaml | 4 + .../project_iterator/tree/agg.gpr | 11 +++ .../project_iterator/tree/lib1.gpr | 7 ++ .../project_iterator/tree/lib2.gpr | 7 ++ .../project_iterator/tree/root.gpr | 5 ++ 8 files changed, 142 insertions(+), 13 deletions(-) create mode 100644 testsuite/tests/projects/aggregated_libraries/project_iterator/test.adb create mode 100644 testsuite/tests/projects/aggregated_libraries/project_iterator/test.yaml create mode 100644 testsuite/tests/projects/aggregated_libraries/project_iterator/tree/agg.gpr create mode 100644 testsuite/tests/projects/aggregated_libraries/project_iterator/tree/lib1.gpr create mode 100644 testsuite/tests/projects/aggregated_libraries/project_iterator/tree/lib2.gpr create mode 100644 testsuite/tests/projects/aggregated_libraries/project_iterator/tree/root.gpr diff --git a/projects/src/gnatcoll-projects.adb b/projects/src/gnatcoll-projects.adb index 2d84a829..b5a1ad0e 100644 --- a/projects/src/gnatcoll-projects.adb +++ b/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; diff --git a/projects/src/gnatcoll-projects.ads b/projects/src/gnatcoll-projects.ads index 2b0da6cf..151e5af4 100644 --- a/projects/src/gnatcoll-projects.ads +++ b/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. diff --git a/testsuite/tests/projects/aggregated_libraries/project_iterator/test.adb b/testsuite/tests/projects/aggregated_libraries/project_iterator/test.adb new file mode 100644 index 00000000..c392ef76 --- /dev/null +++ b/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 -- +-- . -- +-- -- +-- 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; diff --git a/testsuite/tests/projects/aggregated_libraries/project_iterator/test.yaml b/testsuite/tests/projects/aggregated_libraries/project_iterator/test.yaml new file mode 100644 index 00000000..345d652c --- /dev/null +++ b/testsuite/tests/projects/aggregated_libraries/project_iterator/test.yaml @@ -0,0 +1,4 @@ +description: Check aggregated libraries project iteration. +data: + - "tree" + - "test.adb" diff --git a/testsuite/tests/projects/aggregated_libraries/project_iterator/tree/agg.gpr b/testsuite/tests/projects/aggregated_libraries/project_iterator/tree/agg.gpr new file mode 100644 index 00000000..4755fa61 --- /dev/null +++ b/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; \ No newline at end of file diff --git a/testsuite/tests/projects/aggregated_libraries/project_iterator/tree/lib1.gpr b/testsuite/tests/projects/aggregated_libraries/project_iterator/tree/lib1.gpr new file mode 100644 index 00000000..8c223064 --- /dev/null +++ b/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; diff --git a/testsuite/tests/projects/aggregated_libraries/project_iterator/tree/lib2.gpr b/testsuite/tests/projects/aggregated_libraries/project_iterator/tree/lib2.gpr new file mode 100644 index 00000000..3f54c6f3 --- /dev/null +++ b/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; diff --git a/testsuite/tests/projects/aggregated_libraries/project_iterator/tree/root.gpr b/testsuite/tests/projects/aggregated_libraries/project_iterator/tree/root.gpr new file mode 100644 index 00000000..f27c5809 --- /dev/null +++ b/testsuite/tests/projects/aggregated_libraries/project_iterator/tree/root.gpr @@ -0,0 +1,5 @@ +with "./agg.gpr"; + +project Root is + +end Root;