Measure and report test coverage

.github/workflows/harness.yml

@@ -106,7 +106,7 @@ jobs:
         if: ${{ always() }}
         run: |
           cd /home/ocaml/catala
-          opam exec -- clerk report --xml _build/*@test _build/test-*/*@test >report.junit.xml
+          opam exec -- clerk report --report_format=xml _build/*@test _build/test-*/*@test >report.junit.xml
       - name: Test Summary
         uses: test-summary/action@v2
         with:
@@ -153,7 +153,7 @@ jobs:
         if: ${{ always() }}
         run: |
           cd ~/catala-examples
-          opam exec -- clerk report --xml _build/clerk_tests/*@test _build/clerk_tests/test-*/*@test >report.junit.xml
+          opam exec -- clerk report --report-format=xml _build/clerk_tests/*@test _build/clerk_tests/test-*/*@test >report.junit.xml
       - name: Test Summary
         uses: test-summary/action@v2
         with:

build_system/clerk_cli.ml

@@ -50,6 +50,15 @@ let autotest =
            guarantee that the necessary artifacts for interpretation are \
            present.")
 
+let quiet =
+  Arg.(
+    value
+    & flag
+    & info ["quiet"]
+        ~doc:
+          "Silences the $(i,ninja) build tool that usually prints its output \
+           on the standard output.")
+
 let prepare_only =
   Arg.(
     value
@@ -114,7 +123,7 @@ let runtest_report =
     & info ["report"] ~docv:"FILE"
         ~doc:
           "If set, $(i,clerk runtest) will output a tests result summary in \
-           binary format to the given $(b,FILE)")
+           binary format to the given $(b,FILE).")
 
 let runtest_out =
   Arg.(
@@ -139,7 +148,7 @@ let backend =
     & info ["backend"] ~docv:"BACKEND"
         ~doc:
           "Run the program using the given backend. $(docv) must be one of \
-           $(b,interpret), $(b,ocaml), $(b,c), $(b,python), $(b,java)")
+           $(b,interpret), $(b,ocaml), $(b,c), $(b,python), $(b,java).")
 
 let run_command =
   Arg.(
@@ -192,7 +201,7 @@ let ninja_output =
           "$(i,FILE) is the file that will contain the build.ninja file \
            output. If not specified, the build.ninja file is set to \
            $(i,<builddir>/clerk.ninja) in debug mode, and a temporary file \
-           otherwise")
+           otherwise.")
 
 let files_or_folders =
   Arg.(
@@ -253,24 +262,37 @@ let report_verbosity =
     & vflag `Failures
         [
           ( `Summary,
-            info ["summary"] ~doc:"Only display a summary of the test results" );
+            info ["summary"] ~doc:"Only display a summary of the test results."
+          );
           ( `Short,
-            info ["short"] ~doc:"Don't display detailed test failures diff" );
+            info ["short"] ~doc:"Don't display detailed test failures diff." );
           ( `Failures,
             info ["failures"]
-              ~doc:"Show details of files with failed tests only" );
+              ~doc:"Show details of files with failed tests only." );
           ( `Verbose,
             info ["verbose"; "v"]
-              ~doc:"Display the full list of tests that have been run" );
+              ~doc:"Display the full list of tests that have been run." );
         ])
 
-let report_xml =
+let report_format =
+  Arg.(
+    value
+    & opt
+        (enum ["terminal", `Terminal; "xml", `JUnitXML; "json", `VSCodeJSON])
+        `Terminal
+    & info ["report-format"] ~docv:"CATALA_REPORT_FORMAT"
+        ~doc:
+          "Output the test report in a human-friendly format on the terminal \
+           ($(b,terminal)), as a JUnit-compatible XML ($(b,xml)), or as a \
+           VSCode-compatible JSON Format ($(b,json)).")
+
+let code_coverage =
   Arg.(
     value
     & flag
-    & info ["xml"]
-        ~env:(Cmd.Env.info "CATALA_XML_REPORT")
-        ~doc:"Output the test report in JUnit-compatible XML format")
+    & info ["code-coverage"]
+        ~env:(Cmd.Env.info "CATALA_MEASURE_COVERAGE")
+        ~doc:"Measure code coverage in the test report.")
 
 let diff_command =
   Arg.(
@@ -283,7 +305,7 @@ let diff_command =
            side-by-side view. If no argument is supplied, the command will be \
            $(b,patdiff) if available or $(b,diff) otherwise. A supplied \
            argument will be used as diff command with arguments pointing to \
-           the reference file and the output file")
+           the reference file and the output file.")
 
 let ninja_flags =
   let env =

build_system/clerk_cli.mli

@@ -22,6 +22,7 @@ val catala_exe : string option Term.t
 val catala_opts : string list Term.t
 val autotest : bool Term.t
 val prepare_only : bool Term.t
+val quiet : bool Term.t
 val build_dir : string option Term.t
 val include_dirs : string list Term.t
 val test_flags : string list Term.t
@@ -39,7 +40,8 @@ val scope : string option Term.t
 val clerk_targets_or_files : string list Term.t
 val clerk_targets_or_files_or_folders : string list Term.t
 val report_verbosity : [> `Failures | `Short | `Summary | `Verbose ] Term.t
-val report_xml : bool Term.t
+val report_format : [> `Terminal | `JUnitXML | `VSCodeJSON ] Term.t
+val code_coverage : bool Term.t
 val diff_command : string option option Term.t
 val ninja_flags : string list Term.t
 val info : Cmd.info

build_system/clerk_coverage.ml

@@ -0,0 +1,77 @@
+(* This file is part of the Catala build system, a specification language for
+   tax and social benefits computation rules. Copyright (C) 2024 Inria,
+   contributors: Louis Gesbert <[email protected]>
+
+   Licensed under the Apache License, Version 2.0 (the "License"); you may not
+   use this file except in compliance with the License. You may obtain a copy of
+   the License at
+
+   http://www.apache.org/licenses/LICENSE-2.0
+
+   Unless required by applicable law or agreed to in writing, software
+   distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
+   WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
+   License for the specific language governing permissions and limitations under
+   the License. *)
+
+open Catala_utils
+
+module LineMap = Map.Make (struct
+  include Int
+
+  let format fmt x = Format.pp_print_int fmt x
+end)
+
+type aggregated_reachable_code_coverage = Pos_map.loc_interval list File.Map.t
+
+type aggregated_reached_code_coverage =
+  (Pos_map.loc_interval * String.Set.t) list File.Map.t
+
+type coverage_line_map = bool LineMap.t File.Map.t
+
+let aggregated_code_coverage_to_coverage_line_map
+    (agg_reached : aggregated_reached_code_coverage) : coverage_line_map =
+  File.Map.fold
+    (fun file (locations : (Pos_map.loc_interval * String.Set.t) list) acc ->
+      let line_map : bool LineMap.t =
+        List.fold_left
+          (fun (acc : bool LineMap.t) (loc_interval, cov_set) ->
+            let open Pos_map in
+            let cov_bool = not (String.Set.is_empty cov_set) in
+            let lines_concerned =
+              List.init
+                (loc_interval.stop.line - loc_interval.start.line + 1)
+                (fun i -> loc_interval.start.line + i)
+            in
+            List.fold_left
+              (fun (acc : bool LineMap.t) line_concerned ->
+                let existing_cov_kind = LineMap.find_opt line_concerned acc in
+                match existing_cov_kind, cov_bool with
+                | None, cov_bool -> LineMap.add line_concerned cov_bool acc
+                | Some true, _ -> acc
+                | Some false, true -> LineMap.add line_concerned cov_bool acc
+                | _, _ -> acc)
+              acc lines_concerned)
+          LineMap.empty locations
+      in
+      File.Map.add file line_map acc)
+    agg_reached File.Map.empty
+
+let total_coverage_lines (line_map : coverage_line_map) =
+  File.Map.fold (fun _ lines acc -> acc + LineMap.cardinal lines) line_map 0
+
+let positive_coverage_lines (line_map : coverage_line_map) =
+  File.Map.fold
+    (fun _ lines acc ->
+      LineMap.fold
+        (fun _ cov_bool acc -> acc + if cov_bool then 1 else 0)
+        lines acc)
+    line_map 0
+
+let negative_coverage_lines (line_map : coverage_line_map) =
+  File.Map.fold
+    (fun _ lines acc ->
+      LineMap.fold
+        (fun _ cov_bool acc -> acc + if cov_bool then 0 else 1)
+        lines acc)
+    line_map 0