Introduce subprograms of interest

With this change, users now have the ability for finer-grained filtering
- on a subprogram of interest basis. This changes actually provides more
than that: filtering per scopes, which are identified by the
<filename>:<line> of their specification declaration point for Ada, if
they have any (otherwise it is the body declaration point), and by the
body declaration point for C / C++.

The subprograms of interest filtering is applied after all of the units
of interest filtering has been applied. This means that if the users
passes --subprograms=<ignored_file>:<line>, it won't be in the coverage
report.

To implement this, we use the logic implemented to support scope
metrics, and refactor it to use trees instead of ad-hoc data structures.

Author: Jugst3r

testsuite/tests/subp_of_interest/src/main.adb

@@ -0,0 +1,7 @@
+with Pkg;
+
+procedure Main is
+begin
+   Pkg.Foo (1);
+   Pkg.Bar;
+end Main;

testsuite/tests/subp_of_interest/src/pkg.adb

@@ -0,0 +1,14 @@
+with Ada.Text_IO; use Ada.Text_IO;
+
+package body Pkg is
+   procedure Foo (I : Integer) is
+   begin
+      Put_Line ("Hello from Foo!");
+   end Foo;
+
+   procedure Bar is
+   begin
+      Put_Line ("Hello from Bar!");
+   end Bar;
+
+end Pkg;

testsuite/tests/subp_of_interest/src/pkg.ads

@@ -0,0 +1,6 @@
+pragma Ada_2012;
+
+package Pkg is
+   procedure Foo (I : Integer) with Pre => I > 0;
+   procedure Bar;
+end Pkg;

testsuite/tests/subp_of_interest/test.py

@@ -0,0 +1,117 @@
+"""
+Check that the subprograms of interest mechanism works as expected, i.e.
+produces the right coverage expectations for source traces, and the right error
+message for binary traces.
+"""
+
+import os
+import os.path
+
+from SCOV.minicheck import build_and_run, check_xcov_reports
+from SUITE.context import thistest
+from SUITE.cutils import contents_of, Wdir
+from SUITE.tutils import gprfor, xcov
+from SUITE.gprutils import GPRswitches
+
+tmp = Wdir("tmp_")
+
+cov_args = build_and_run(
+    gprsw=GPRswitches(
+        gprfor(srcdirs=os.path.join("..", "src"), mains=["main.adb"])
+    ),
+    covlevel="stmt",
+    mains=["main"],
+    extra_coverage_args=["-axcov"],
+)
+
+# Produce a coverage report and a checkpoint with the subprogram switch. Check
+# that the coverage report contains only coverage data for the specific
+# subprogram for source traces. For binary traces, simply check that the
+# gnatcov coverage invocation yields the expected warning.
+os.mkdir("xcov_subp")
+xcov(
+    cov_args
+    + [
+        "--save-checkpoint",
+        "trace.ckpt",
+        "--subprograms",
+        f"{os.path.join('..', 'src', 'pkg.ads')}:4",
+        "--output-dir=xcov_subp",
+    ],
+    out="coverage.log",
+)
+if thistest.options.trace_mode == "bin":
+    thistest.fail_if_no_match(
+        "gnatcov coverage output",
+        "warning: Ignoring --subprograms switches as this is not supported with"
+        " binary traces.",
+        contents_of("coverage.log"),
+    )
+else:
+    check_xcov_reports(
+        "*.xcov",
+        {
+            "main.adb.xcov": {},
+            "pkg.adb.xcov": {"+": {6}},
+        },
+        "xcov_subp",
+    )
+
+    # Then check that the checkpoint contains only coverage data for the specific
+    # subprogram. To do this, produce a new coverage report from the checkpoint
+    # without using the --subprograms switch.
+    xcov(
+        cov_args[:-1]
+        + ["--checkpoint", "trace.ckpt", "--output-dir=xcov_no_subp"]
+    )
+    check_xcov_reports(
+        "*.xcov",
+        {
+            "main.adb.xcov": {"-": {5, 6}},
+            "pkg.adb.xcov": {"+": {6}, "-": {11}},
+        },
+        "xcov_no_subp",
+    )
+
+    # Also check the warnings when the subprogram switch is ill-formed
+
+    # Case 1: missing colon in the argument
+    xcov(
+        cov_args + ["--subprograms", "no-colon"],
+        out="xcov-wrong1.txt",
+        register_failure=False,
+    )
+    thistest.fail_if_no_match(
+        what="unexpected coverage output",
+        regexp=r".*Wrong argument passed to --subprograms: .*",
+        actual=contents_of("xcov-wrong1.txt"),
+    )
+    
+    # Case 2: line number is not a number
+    xcov(
+        cov_args + ["--subprograms", f"{os.path.join('..', 'src', 'pkg.ads')}:b",],
+        out="xcov-wrong2.txt",
+        register_failure=False,
+    )
+    thistest.fail_if_no_match(
+        what="unexpected coverage output",
+        regexp=r".*Wrong argument passed to --subprograms: .*",
+        actual=contents_of("xcov-wrong2.txt"),
+    )
+    
+    # Case 3: file does not exist
+    xcov(
+        cov_args + ["--subprograms", "dumb-file-name:4"],
+        out="xcov-wrong3.txt",
+        register_failure=False,
+    )
+    thistest.fail_if_no_match(
+        what="unexpected coverage output",
+        regexp=r".*Error when parsing --subprograms argument dumb-file-name:4:"
+        r".*dumb-file-name does not exist",
+        actual=contents_of("xcov-wrong3.txt"),
+    )
+
+
+
+thistest.result()

tools/gnatcov/annotations-cobertura.adb

@@ -253,7 +253,8 @@ package body Annotations.Cobertura is
 
       Pp.Need_Sources := False;
 
-      Annotations.Generate_Report (Pp, True, Subdir => "cobertura");
+      Annotations.Generate_Report
+        (Pp, True, Context.Subps_Of_Interest, Subdir => "cobertura");
       Free (Pp.Source_Prefix_Pattern);
    end Generate_Report;
 

tools/gnatcov/annotations-dynamic_html.adb

@@ -150,9 +150,10 @@ package body Annotations.Dynamic_Html is
 
    procedure Pretty_Print_End_File (Pp : in out Dynamic_Html);
 
-   procedure Pretty_Print_Scope_Entity
-     (Pp        : in out Dynamic_Html;
-      Scope_Ent : Scope_Entity);
+   procedure Pretty_Print_Scope_Entities
+     (Pp             : in out Dynamic_Html;
+      File           : Source_File_Index;
+      Scope_Entities : Scope_Entities_Tree);
 
    procedure Pretty_Print_Start_Line
      (Pp       : in out Dynamic_Html;
@@ -294,8 +295,9 @@ package body Annotations.Dynamic_Html is
    begin
       Annotations.Generate_Report
         (Pp,
-         Show_Details => True,
-         Subdir       => "html");
+         Show_Details     => True,
+         Subp_Of_Interest => Context.Subps_Of_Interest,
+         Subdir           => "html");
    end Generate_Report;
 
    ------------------------
@@ -516,15 +518,18 @@ package body Annotations.Dynamic_Html is
       Append (Pp.Source_List, Simplified);
    end Pretty_Print_End_File;
 
-   -------------------------------
-   -- Pretty_Print_Scope_Entity --
-   -------------------------------
+   ---------------------------------
+   -- Pretty_Print_Scope_Entities --
+   ---------------------------------
 
-   procedure Pretty_Print_Scope_Entity
-     (Pp        : in out Dynamic_Html;
-      Scope_Ent : Scope_Entity)
+   procedure Pretty_Print_Scope_Entities
+     (Pp             : in out Dynamic_Html;
+      File           : Source_File_Index;
+      Scope_Entities : Scope_Entities_Tree)
    is
-      function To_JSON (Scope_Ent : Scope_Entity) return JSON_Value;
+      use Scope_Entities_Trees;
+
+      function To_JSON (Cur : Cursor) return JSON_Value;
       --  Convert a scope entity to a JSON scoped metric: compute line and
       --  obligation statistics for the given scope and recursively for
       --  child scopes. Store the result as a JSON object, with the name and
@@ -534,37 +539,41 @@ package body Annotations.Dynamic_Html is
       -- To_JSON --
       -------------
 
-      function To_JSON (Scope_Ent : Scope_Entity) return JSON_Value is
+      function To_JSON (Cur : Cursor) return JSON_Value
+      is
+         Scope_Ent : constant Scope_Entity := Element (Cur);
+         Child     : Cursor := First_Child (Cur);
+
          Scope_Metrics_JSON          : constant JSON_Value := Create_Object;
          Children_Scope_Metrics_JSON : JSON_Array;
-         FI                          : constant File_Info_Access :=
-           Get_File (First_Sloc (Scope_Ent.From).Source_File);
-         Line_Stats                  : constant Li_Stat_Array :=
+         --  Representation of the scope metrics for the html format
+
+         Line_Stats : constant Li_Stat_Array :=
            Line_Metrics
-             (FI,
+             (Get_File (File),
               First_Sloc (Scope_Ent.From).L.Line,
               Last_Sloc (Scope_Ent.To).L.Line);
-         Ob_Stats                    : constant Ob_Stat_Array :=
+         Ob_Stats   : constant Ob_Stat_Array :=
            Obligation_Metrics (Scope_Ent.From, Scope_Ent.To);
       begin
          Scope_Metrics_JSON.Set_Field ("scopeName", Scope_Ent.Name);
          Scope_Metrics_JSON.Set_Field ("scopeLine", Scope_Ent.Sloc.Line);
          Scope_Metrics_JSON.Set_Field ("stats", To_JSON (Line_Stats));
          Scope_Metrics_JSON.Set_Field ("enAllStats", To_JSON (Ob_Stats));
-         for Child_Scope_Ent of Scope_Ent.Children loop
-            Append
-              (Children_Scope_Metrics_JSON,
-               To_JSON (Child_Scope_Ent.all));
+         while Has_Element (Child) loop
+            Append (Children_Scope_Metrics_JSON, To_JSON (Child));
+            Child := Next_Sibling (Child);
          end loop;
          Scope_Metrics_JSON.Set_Field
-           ("children",
-            Create (Children_Scope_Metrics_JSON));
+           ("children", Create (Children_Scope_Metrics_JSON));
          return Scope_Metrics_JSON;
       end To_JSON;
 
    begin
-      Pp.Scope_Metrics := To_JSON (Scope_Ent);
-   end Pretty_Print_Scope_Entity;
+      for Cur in Scope_Entities.Iterate_Children (Scope_Entities.Root) loop
+         Pp.Scope_Metrics := To_JSON (Cur);
+      end loop;
+   end Pretty_Print_Scope_Entities;
 
    -----------------------------
    -- Pretty_Print_Start_Line --

tools/gnatcov/annotations-html.adb

@@ -224,6 +224,7 @@ package body Annotations.Html is
       Annotations.Generate_Report
         (Pp,
          Show_Details,
+         Context.Subps_Of_Interest,
          Subdir => (if Show_Details then "shtml+" else "shtml"));
    end Generate_Report;
 

tools/gnatcov/annotations-report.adb

@@ -242,7 +242,7 @@ package body Annotations.Report is
          Open_Report_File (Final_Report_Name.all);
       end if;
 
-      Annotations.Generate_Report (Pp, True);
+      Annotations.Generate_Report (Pp, True, Context.Subps_Of_Interest);
       Close_Report_File;
    end Generate_Report;
 

tools/gnatcov/annotations-xcov.adb

@@ -88,6 +88,7 @@ package body Annotations.Xcov is
       Annotations.Generate_Report
         (Pp,
          Show_Details,
+         Context.Subps_Of_Interest,
          Subdir        => (if Pp.Show_Details then "xcov+" else "xcov"),
          Clean_Pattern => "*.xcov");
    end Generate_Report;

tools/gnatcov/annotations-xml.adb

@@ -138,9 +138,10 @@ package body Annotations.Xml is
 
    procedure Pretty_Print_End_File (Pp : in out Xml_Pretty_Printer);
 
-   procedure Pretty_Print_Scope_Entity
-     (Pp        : in out Xml_Pretty_Printer;
-      Scope_Ent : Scope_Entity);
+   procedure Pretty_Print_Scope_Entities
+     (Pp             : in out Xml_Pretty_Printer;
+      File           : Source_File_Index;
+      Scope_Entities : Scope_Entities_Tree);
 
    procedure Pretty_Print_Start_Line
      (Pp       : in out Xml_Pretty_Printer;
@@ -293,7 +294,8 @@ package body Annotations.Xml is
          Context      => Context,
          others       => <>);
    begin
-      Annotations.Generate_Report (Pp, True, Subdir => "xml");
+      Annotations.Generate_Report
+        (Pp, True, Context.Subps_Of_Interest, Subdir => "xml");
    end Generate_Report;
 
    -------
@@ -565,36 +567,54 @@ package body Annotations.Xml is
             Dest_Index);
    end Pretty_Print_Start_File;
 
-   -------------------------------
-   -- Pretty_Print_Scope_Entity --
-   -------------------------------
+   ---------------------------------
+   -- Pretty_Print_Scope_Entities --
+   ---------------------------------
 
-   procedure Pretty_Print_Scope_Entity
-     (Pp        : in out Xml_Pretty_Printer;
-      Scope_Ent : Scope_Entity)
+   procedure Pretty_Print_Scope_Entities
+     (Pp             : in out Xml_Pretty_Printer;
+      File           : Source_File_Index;
+      Scope_Entities : Scope_Entities_Tree)
    is
-      FI : constant File_Info_Access :=
-        Get_File (First_Sloc (Scope_Ent.From).Source_File);
-   begin
-      Pp.ST ("scope_metric",
-             A ("scope_name", Scope_Ent.Name)
-             & A ("scope_line", Img (Scope_Ent.Sloc.Line)));
-      Print_Coverage_Li_Stats
-        (Pp,
-         Line_Metrics
-           (FI,
-            First_Sloc (Scope_Ent.From).L.Line,
-            Last_Sloc (Scope_Ent.To).L.Line),
-         Dest_Compilation_Unit);
-      Print_Coverage_Ob_Stats
-        (Pp,
-         Obligation_Metrics (Scope_Ent.From, Scope_Ent.To),
-         Dest_Compilation_Unit);
-      for Child of Scope_Ent.Children loop
-         Pp.Pretty_Print_Scope_Entity (Child.all);
+      use Scope_Entities_Trees;
+
+      procedure Pp_Scope_Entity (Cur : Cursor);
+
+      ---------------------
+      -- Pp_Scope_Entity --
+      ---------------------
+
+      procedure Pp_Scope_Entity (Cur : Cursor)
+      is
+         Scope_Ent : constant Scope_Entity := Element (Cur);
+         Child     : Cursor := First_Child (Cur);
+      begin
+         Pp.ST ("scope_metric",
+                A ("scope_name", Scope_Ent.Name)
+                & A ("scope_line", Img (Scope_Ent.Sloc.Line)));
+         Print_Coverage_Li_Stats
+           (Pp,
+            Line_Metrics
+              (Get_File (File),
+               First_Sloc (Scope_Ent.From).L.Line,
+               Last_Sloc (Scope_Ent.To).L.Line),
+            Dest_Compilation_Unit);
+         Print_Coverage_Ob_Stats
+           (Pp,
+            Obligation_Metrics (Scope_Ent.From, Scope_Ent.To),
+            Dest_Compilation_Unit);
+         while Has_Element (Child) loop
+            Pp_Scope_Entity (Child);
+            Child := Next_Sibling (Child);
+         end loop;
+         Pp.ET ("scope_metric");
+      end Pp_Scope_Entity;
+
+   begin
+      for Cur in Scope_Entities.Iterate_Children (Scope_Entities.Root) loop
+         Pp_Scope_Entity (Cur);
       end loop;
-      Pp.ET ("scope_metric");
-   end Pretty_Print_Scope_Entity;
+   end Pretty_Print_Scope_Entities;
 
    ----------------------------------------
    -- Pretty_Print_Start_Instruction_Set --