Merge branch 'leo/110-minimization' into 'master'

Introduce testsuite minimization

See merge request eng/ide/libadalang-tools!183

src/test-actions.adb

@@ -55,6 +55,7 @@ with Test.Common;
 with Test.Skeleton.Source_Table;
 with Test.Harness.Source_Table;
 with Test.Generation;
+with Test.Suite_Min;
 
 with Ada.Directories; use Ada.Directories;
 with Utils.Projects; use Utils.Projects;
@@ -1038,6 +1039,20 @@ package body Test.Actions is
          Test.Harness.Generate_Makefile (Src_Prj);
          Test.Harness.Generate_Config;
          Test.Common.Generate_Common_File;
+
+         --  We need to minimize the testsuite before generating the mapping
+         --  file, as the generation of this file clears the mapping data
+         --  structure.
+
+         if Arg (Cmd, Minimize) then
+            if Test.Common.Harness_Has_Gen_Tests then
+               Test.Suite_Min.Minimize_Suite (Cmd);
+            else
+               Test.Common.Report_Err
+                 ("No generated tests found in the harness,"
+                  & " nothing to do in the minimization phase.");
+            end if;
+         end if;
          Test.Mapping.Generate_Mapping_File;
 
       end if;

src/test-command_lines.ads

@@ -52,7 +52,8 @@ package Test.Command_Lines is
       Serialized_Test_Dir,
       Dump_Test_Inputs,
       Unparse,
-      Enum_Strat);
+      Enum_Strat,
+      Minimize);
 
    package Test_Boolean_Switches is new Boolean_Switches
      (Descriptor,
@@ -91,7 +92,8 @@ package Test.Command_Lines is
       Copy_Environment,
       Reporter,
       Gen_Test_Num,
-      Serialized_Test_Dir);
+      Serialized_Test_Dir,
+      Cov_Level);
 
    package Test_String_Switches is new String_Switches
      (Descriptor,
@@ -110,7 +112,8 @@ package Test.Command_Lines is
        Copy_Environment         => '=',
        Reporter                 => '=',
        Gen_Test_Num             => '=',
-       Serialized_Test_Dir      => '=']);
+       Serialized_Test_Dir      => '=',
+       Cov_Level                => '=']);
 
    type Test_String_Seqs is (Exclude_From_Stubbing);
 

src/test-common.adb

@@ -23,6 +23,7 @@
 
 with Libadalang.Common;         use Libadalang.Common;
 
+with Ada.Directories;
 with Ada.Text_IO;               use Ada.Text_IO;
 with Ada.IO_Exceptions;
 with Ada.Exceptions;            use Ada.Exceptions;
@@ -1253,4 +1254,16 @@ package body Test.Common is
       Need_Lib_Support := Generated;
    end Mark_Lib_Support_Generated;
 
+   ---------------------------
+   -- Harness_Has_Gen_Tests --
+   ---------------------------
+
+   function Harness_Has_Gen_Tests return Boolean is
+     (Need_Lib_Support = Generated
+      and then JSON_Test_Dir /= null
+      and then Ada.Directories.Exists (JSON_Test_Dir.all));
+
+   --  The harness can only have generated tests if the support library has
+   --  been generated, and the JSON_Test dir exists.
+
 end Test.Common;

src/test-common.ads

@@ -407,6 +407,9 @@ package Test.Common is
    procedure Mark_Lib_Support_Generated;
    --  Flag that the TGen support library has already been generated
 
+   function Harness_Has_Gen_Tests return Boolean;
+   --  Return whether the harness contains any generated tests
+
    TGen_Num_Tests : Natural := 5;
    --  Number of tests to be generated for each procedure (or upper limit if
    --  using enumerative strategies).

src/test-generation.adb

@@ -26,12 +26,12 @@ with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
 with GNAT.OS_Lib;
 
 with Test.Actions;
-with Test.Common;                use Test.Common;
+with Test.Common;        use Test.Common;
 with Test.Command_Lines;
-with Utils.Command_Lines.Common; use Utils.Command_Lines.Common;
-with Utils_Debug;                use Utils_Debug;
-with Utils.Drivers;              use Utils.Drivers;
-with Utils.Environment;          use Utils.Environment;
+with Test.Subprocess;    use Test.Subprocess;
+with Utils_Debug;        use Utils_Debug;
+with Utils.Drivers;      use Utils.Drivers;
+with Utils.Environment;  use Utils.Environment;
 
 with GNATCOLL.OS.Process;
 
@@ -128,34 +128,16 @@ package body Test.Generation is
 
    procedure Generate_Build_And_Run (Cmd : Command_Line) is
       use GNATCOLL.OS.Process;
-      use Common_String_Seq_Switches;
       Directory_Separator : Character renames GNAT.OS_Lib.Directory_Separator;
-      type Arg_List_Acc is access all Argument_List;
-      Build_Args    : aliased Argument_List;
-      Run_Args      : aliased Argument_List;
+
+      Build_Args    : Argument_List;
+      Run_Args      : Argument_List;
       Harness_Dir   : constant String :=
         Tool_Temp_Dir.all & Directory_Separator & "tgen_Harness";
-      Ext_Vars : constant String_Ref_Array := Arg (Cmd, External_Variable);
-      Ret_Status    : Integer;
       Ext_Acc       : GNAT.OS_Lib.String_Access :=
         GNAT.OS_Lib.Get_Executable_Suffix;
       Ext           : constant String := Ext_Acc.all;
 
-      procedure PP_Cmd (Cmd : Arg_List_Acc);
-
-      ------------
-      -- PP_Cmd --
-      ------------
-
-      procedure PP_Cmd (Cmd : Arg_List_Acc) is
-         Result : Unbounded_String;
-      begin
-         for Arg of Cmd.all loop
-            Result := Result & Arg & " ";
-         end loop;
-         Report_Err ("Running " & To_String (Result));
-      end PP_Cmd;
-
    begin
       GNAT.OS_Lib.Free (Ext_Acc);
 
@@ -178,11 +160,7 @@ package body Test.Generation is
       Build_Args.Append ("-P");
       Build_Args.Append
         (Harness_Dir & Directory_Separator & "tgen_generation_harness.gpr");
-      for Var of Ext_Vars loop
-         if Var not in null then
-            Build_Args.Append ("-X" & Var.all);
-         end if;
-      end loop;
+      Populate_X_Vars (Build_Args, Cmd);
 
       --  Suppress all warning/info messages and style checks
 
@@ -193,30 +171,13 @@ package body Test.Generation is
       if Debug_Flag_1 then
          Build_Args.Append ("-g");
          Build_Args.Append ("-O0");
-         PP_Cmd (Build_Args'Access);
-      end if;
-      Ret_Status := Run (Build_Args);
-      if Ret_Status /= 0 then
-         Report_Err ("Build of generation harness exited with status"
-                     & Ret_Status'Image);
-         Clean_Up;
-         GNAT.OS_Lib.OS_Exit (1);
       end if;
+      Run (Build_Args, "Build of the test generation harness");
 
       Run_Args.Append
         (Harness_Dir & Directory_Separator & "obj" & Directory_Separator
          & "generation_main" & Ext);
-
-      if Debug_Flag_1 then
-         PP_Cmd (Run_Args'Access);
-      end if;
-      Ret_Status := Run (Run_Args);
-      if Ret_Status /= 0 then
-         Report_Err ("Run of generation harness exited with status"
-                     & Ret_Status'Image);
-         Clean_Up;
-         GNAT.OS_Lib.OS_Exit (1);
-      end if;
+      Run (Run_Args, "Execution of the test generation harness");
    end Generate_Build_And_Run;
 
 end Test.Generation;

src/test-harness.adb

@@ -1145,15 +1145,22 @@ package body Test.Harness is
       S_Put (0, "project Test_Driver is");
       Put_New_Line;
       Put_New_Line;
-      S_Put
-           (3,
-            "for Origin_Project use """
-            & (+Relative_Path
-                 (Create (+Source_Prj),
-                   Create (+Harness_Dir.all)))
-            & """;");
-      Put_New_Line;
-      Put_New_Line;
+
+      --  When using the test generation features, do not emit an origin
+      --  project attribute, otherwise gnatcov will not process the harness
+      --  project at all.
+
+      if not Test.Common.Harness_Has_Gen_Tests then
+         S_Put
+            (3,
+               "for Origin_Project use """
+               & (+Relative_Path
+                  (Create (+Source_Prj),
+                     Create (+Harness_Dir.all)))
+               & """;");
+         Put_New_Line;
+         Put_New_Line;
+      end if;
       S_Put (3, "for Target use Gnattest_Common'Target;");
       Put_New_Line;
       Put_New_Line;
@@ -2813,21 +2820,29 @@ package body Test.Harness is
             & " is");
          Put_New_Line;
          Put_New_Line;
-         if Relocatable_Harness then
-            S_Put
-              (3,
-               "for Origin_Project use external "
-               & "(""ORIGIN_PROJECT_DIR"", """") & """
-               & Base_Name (Source_Prj)
-               & """;");
-         else
-            S_Put
-              (3,
-               "for Origin_Project use """
-               & (+Relative_Path
-                 (Create (+Source_Prj),
-                      Create (+Normalize_Pathname (Dir_Name (P.Path_TD.all)))))
-               & """;");
+
+         --  When using the test generation features, do not emit an origin
+         --  project attribute, otherwise gnatcov will not process the harness
+         --  project at all.
+
+         if not Test.Common.Harness_Has_Gen_Tests then
+            if Relocatable_Harness then
+               S_Put
+               (3,
+                "for Origin_Project use external "
+                & "(""ORIGIN_PROJECT_DIR"", """") & """
+                & Base_Name (Source_Prj)
+                & """;");
+            else
+               S_Put
+               (3,
+                "for Origin_Project use """
+                & (+Relative_Path
+                    (Create (+Source_Prj),
+                        Create
+                          (+Normalize_Pathname (Dir_Name (P.Path_TD.all)))))
+                & """;");
+            end if;
          end if;
          Put_New_Line;
          Put_New_Line;
@@ -3255,21 +3270,29 @@ package body Test.Harness is
             & P.Name_TD.all
             & " is");
          Put_New_Line;
-         if Relocatable_Harness then
-            S_Put
-              (3,
-               "for Origin_Project use external "
-               & "(""ORIGIN_PROJECT_DIR"", """") & """
-               & Base_Name (P.Path_Of_Extended.all)
-               & """;");
-         else
-            S_Put
-              (3,
-               "for Origin_Project use """
-               & (+Relative_Path
-                 (Create (+P.Path_Of_Extended.all),
-                      Create (+Normalize_Pathname (Dir_Name (P.Path_TD.all)))))
-               & """;");
+
+         --  When using the test generation features, do not emit an origin
+         --  project attribute, otherwise gnatcov will not process the harness
+         --  project at all.
+
+         if not Test.Common.Harness_Has_Gen_Tests then
+            if Relocatable_Harness then
+               S_Put
+               (3,
+                "for Origin_Project use external "
+                & "(""ORIGIN_PROJECT_DIR"", """") & """
+                & Base_Name (P.Path_Of_Extended.all)
+                & """;");
+            else
+               S_Put
+               (3,
+                "for Origin_Project use """
+                & (+Relative_Path
+                     (Create (+P.Path_Of_Extended.all),
+                        Create
+                          (+Normalize_Pathname (Dir_Name (P.Path_TD.all)))))
+                & """;");
+            end if;
          end if;
          Put_New_Line;
          Put_New_Line;
@@ -3560,22 +3583,28 @@ package body Test.Harness is
             end loop;
          end if;
 
-         Put_New_Line;
-         if Relocatable_Harness then
-            S_Put
-              (3,
-               "for Origin_Project use external "
-               & "(""ORIGIN_PROJECT_DIR"", """") & """
-               & Base_Name (Source_Prj)
-               & """;");
-         else
-            S_Put
-              (3,
-               "for Origin_Project use """
-               & (+Relative_Path
-                 (Create (+Source_Prj),
-                      Create (+Normalize_Pathname (Harness_Dir.all))))
-               & """;");
+         --  When using the test generation features, do not emit an origin
+         --  project attribute, otherwise gnatcov will not process the harness
+         --  project at all.
+
+         if not Test.Common.Harness_Has_Gen_Tests then
+            Put_New_Line;
+            if Relocatable_Harness then
+               S_Put
+               (3,
+                "for Origin_Project use external "
+                & "(""ORIGIN_PROJECT_DIR"", """") & """
+                & Base_Name (Source_Prj)
+                & """;");
+            else
+               S_Put
+               (3,
+                "for Origin_Project use """
+                & (+Relative_Path
+                     (Create (+Source_Prj),
+                        Create (+Normalize_Pathname (Harness_Dir.all))))
+                & """;");
+            end if;
          end if;
          Put_New_Line;
          Put_New_Line;

src/test-mapping.ads

@@ -86,6 +86,9 @@ package Test.Mapping is
       Column    : Natural;
       --  Sloc for the subprogram under test
 
+      TR_Hash   : String_Access;
+      --  Full hash for the subprogram under test
+
       TC_List   : TC_Mapping_List.List;
       --  List of testcases holding the information above, if there are
       --  several.
@@ -95,6 +98,9 @@ package Test.Mapping is
       --  this one points at the first line of declaration. This is needed
       --  to properly support cases with "overriding/not overriding" decorators
       --  in test filtering, as decorator usually takes an extra line.
+
+      Decl_File : String_Access;
+      --  Full filename in which the subprogram under test is declared
    end record;
    --  Stores info on individual subprogram under test and collection of
    --  corresponding test cases (if any).
@@ -126,6 +132,7 @@ package Test.Mapping is
       TearDown_Column : Natural;
       TR_List         : TR_Mapping_List.List;
       DT_List         : DT_Mapping_List.List;
+      Has_Gen_Tests   : Boolean := False;
    end record;
    --  Stores info on individual test package, all it's test routines and
    --  dangling tests.