add a --list flag to alr test

Author: AldanTanneo

src/alire/alire-test_runner.adb

@@ -486,28 +486,17 @@ package body Alire.Test_Runner is
       end loop;
    end Run_All_Tests;
 
-   ---------
-   -- Run --
-   ---------
+   -------------------
+   -- Get_File_List --
+   -------------------
 
-   function Run
-     (Root   : in out Roots.Root;
-      Filter : AAA.Strings.Vector := AAA.Strings.Empty_Vector;
-      Jobs   : Natural := 0) return Integer
+   function Get_File_List
+     (Root : Roots.Root; Filter : AAA.Strings.Vector)
+      return Portable_Path_Vector
    is
-      use all type AAA.Strings.Vector;
-
-      Job_Count : constant Positive :=
-        (if Jobs = 0
-         then Positive (System.Multiprocessors.Number_Of_CPUs)
-         else Jobs);
-      Path      : constant Absolute_Path := Root.Path;
-
-      Crate_Prefix      : constant String := Root_Prefix (Root);
-      Original_Switch_Q : constant Boolean := Alire_Early_Elaboration.Switch_Q;
+      Crate_Prefix : constant String := Root_Prefix (Root);
 
       Test_List : Portable_Path_Vector;
-
       --------------------
       -- Matches_Filter --
       --------------------
@@ -551,10 +540,30 @@ package body Alire.Test_Runner is
             Test_List.Append (Name);
          end if;
       end Append;
-
    begin
-      Den.Walk.Find (This => Path / "src", Action => Append'Access);
+      Den.Walk.Find (This => Root.Path / "src", Action => Append'Access);
+      return Test_List;
+   end Get_File_List;
 
+   ---------
+   -- Run --
+   ---------
+
+   function Run
+     (Root   : in out Roots.Root;
+      Filter : AAA.Strings.Vector := AAA.Strings.Empty_Vector;
+      Jobs   : Natural := 0) return Integer
+   is
+      Job_Count : constant Positive :=
+        (if Jobs = 0
+         then Positive (System.Multiprocessors.Number_Of_CPUs)
+         else Jobs);
+
+      Original_Switch_Q : constant Boolean := Alire_Early_Elaboration.Switch_Q;
+
+      Test_List : constant Portable_Path_Vector :=
+        Get_File_List (Root, Filter);
+   begin
       Create_Gpr_List (Root, Test_List);
 
       --  Ensure a void solution on first test run
@@ -584,4 +593,52 @@ package body Alire.Test_Runner is
          return 1;
       end if;
    end Run;
+
+   ---------------
+   -- Show_List --
+   ---------------
+
+   procedure Show_List
+     (Root   : Roots.Root;
+      Filter : AAA.Strings.Vector := AAA.Strings.Empty_Vector)
+   is
+      Crate_Prefix : constant String := Root_Prefix (Root);
+      Path         : constant Absolute_Path := Root.Path;
+      Test_List    : constant Portable_Path_Vector :=
+        Get_File_List (Root, Filter);
+   begin
+      if Tables.Structured_Output then
+         declare
+            Builder : LML.Output.Builder'Class :=
+              LML.Output.Factory.Get (Tables.Structured_Output_Format);
+         begin
+            Builder.Begin_Map;
+            Builder.Insert (LML.Decode (TOML_Keys.Test_Report_Cases));
+            Builder.Begin_Map;
+            for Test of Test_List loop
+               Builder.Insert (LML.Decode (Display_Name (Test, Crate_Prefix)));
+               Builder.Begin_Map;
+               Builder.Insert (LML.Decode (TOML_Keys.Test_Report_Path));
+               Builder.Append
+                 (LML.Scalars.New_Text
+                    (LML.Decode (Path / "src" / String (Test))));
+               Builder.End_Map;
+            end loop;
+            Builder.End_Map;
+            Builder.End_Map;
+
+            Trace.Always (LML.Encode (Builder.To_Text));
+         end;
+      else
+         Put_Info ("Matching tests:");
+         for Test of Test_List loop
+            Trace.Info
+              ("   "
+               & Display_Name (Test, Crate_Prefix)
+               & (if Alire_Early_Elaboration.Switch_V
+                  then " (" & (Path / "src" / String (Test)) & ")"
+                  else ""));
+         end loop;
+      end if;
+   end Show_List;
 end Alire.Test_Runner;

src/alire/alire-test_runner.ads

@@ -11,4 +11,10 @@ package Alire.Test_Runner is
    --  Run all .adb files in the `src` folder of the given root as
    --  separate tests. Return the number of failing tests.
 
+   procedure Show_List
+     (Root   : Roots.Root;
+      Filter : AAA.Strings.Vector := AAA.Strings.Empty_Vector);
+   --  Print a list of matching tests without running them. Respects structured
+   --  output.
+
 end Alire.Test_Runner;

src/alire/alire-toml_keys.ads

@@ -68,6 +68,7 @@ package Alire.TOML_Keys with Preelaborate is
    Test_Report_Reason   : constant String := "reason";
    Test_Report_Output   : constant String := "output";
    Test_Report_Duration : constant String := "duration";
+   Test_Report_Path     : constant String := "path";
    Test_Report_Summary  : constant String := "summary";
    Test_Report_Total    : constant String := "total";
    Test_Report_Failures : constant String := "failures";

src/alr/alr-commands-test.adb

@@ -29,10 +29,9 @@ package body Alr.Commands.Test is
            (Root.Environment,
             (Alire.Properties.Actions.Test => True, others => False))
            .Is_Empty
-        and then not Alire.Roots.Build
-                       (Root,
-                        AAA.Strings.Empty_Vector,
-                        Saved_Profiles => False)
+        and then
+          not Alire.Roots.Build
+                (Root, AAA.Strings.Empty_Vector, Saved_Profiles => False)
       then
          Success := 1;
       else
@@ -100,6 +99,8 @@ package body Alr.Commands.Test is
       Cmd.Requires_Workspace;
 
       if Cmd.Legacy then
+         Cmd.Forbids_Structured_Output
+           ("Cannot use structured output with legacy actions");
          Execute_Legacy (Cmd.Root);
          return;
       end if;
@@ -118,6 +119,8 @@ package body Alr.Commands.Test is
 
       if All_Settings.Is_Empty then
          Trace.Warning ("no test runner defined, running legacy actions");
+         Cmd.Forbids_Structured_Output
+           ("Cannot use structured output with legacy actions");
          Execute_Legacy (Cmd.Root);
          return;
       end if;
@@ -158,10 +161,18 @@ package body Alr.Commands.Test is
         and then Settings (All_Settings.First_Element).Runner.Kind = External
         and then Cmd.Jobs >= 0
       then
-         Trace.Warning
-           ("the --jobs flag is not forwarded to external commands. If you "
-            & "intended to pass it to an external test runner, put it after "
-            & """--"" in the command line.");
+         if Cmd.Jobs >= 0 then
+            Trace.Warning
+              ("the --jobs flag is not forwarded to external commands. If you "
+               & "intended to pass it to an external test runner, put it after"
+               & " ""--"" in the command line.");
+         end if;
+         if Cmd.List then
+            Trace.Warning
+              ("the --list flag is not forwarded to external commands. If you "
+               & "intended to pass it to an external test runner, put it after"
+               & " ""--"" in the command line.");
+         end if;
       end if;
 
       for Test_Setting of All_Settings loop
@@ -200,6 +211,12 @@ package body Alr.Commands.Test is
                            & ")");
                      end if;
 
+                     if Cmd.List then
+                        Alire.Test_Runner.Show_List
+                          (Test_Root.Value, Get_Args);
+                        OS_Lib.Bailout;
+                     end if;
+
                      Failures :=
                        Alire.Test_Runner.Run
                          (Test_Root.Value,
@@ -294,6 +311,14 @@ package body Alr.Commands.Test is
          CLIC.TTY.Error ("Deprecated")
          & ". Force executing the legacy test actions",
          Value => True);
+
+      Define_Switch
+        (Config,
+         Cmd.List'Access,
+         "",
+         "--list",
+         "Show a list of matching tests without running them",
+         Value => True);
    end Setup_Switches;
 
 end Alr.Commands.Test;

src/alr/alr-commands-test.ads

@@ -35,9 +35,10 @@ package Alr.Commands.Test is
 private
 
    type Command is new Commands.Command with record
-      Jobs : aliased Integer := 0;
-      By_Id : aliased GNAT.Strings.String_Access;
+      Jobs   : aliased Integer := 0;
+      By_Id  : aliased GNAT.Strings.String_Access;
       Legacy : aliased Boolean := False;
+      List   : aliased Boolean := False;
    end record;
 
 end Alr.Commands.Test;