Add support for bisect_ppx (ocaml#3403)

Signed-off-by: Stephanie You <youstephanie98@gmail.com>
Co-authored-by: Jérémie Dimino <jeremie@dimino.org>

.travis-ci.sh

@@ -30,7 +30,8 @@ opam_install_test_deps () {
          ocaml-migrate-parsetree \
          result.1.4 \
          utop.2.4.2 \
-         mdx.1.6.0
+         mdx.1.6.0 \
+         bisect_ppx
     # We install Coq separatedly as to be more resistant w.r.t. the 10
     # minutes Travis timeout; the travis_wait hack doesn't work well
     # with Dune's current setup. Note that Travis caching should help

CHANGES.md

@@ -7,6 +7,9 @@ next
 
 - Generate correct META files for sub-libraries (of the form `lib.foo`) that
   contain .js runtime files. (#3445, @hhugo)
+
+- Allow bisect_ppx to be enabled/disabled via dune-workspace. (#3404,
+  @stephanieyou)
 
 - Correctly infer targets for the `diff?` action. (#3457, fixes #2990, @greedy)
 

doc/bisect.rst

@@ -0,0 +1,72 @@
+*************************
+Code coverage with bisect
+*************************
+
+In this section, we will explain how to set up code coverage with bisect_ppx_ so
+that you can enable and disable coverage via ``dune-workspace`` files. This
+setup avoids creating a hard dependency on ``bisect_ppx`` in your project.
+
+Specifying what to bisect
+=========================
+
+First we must include ``(using bisect_ppx 1.0)`` in our ``dune-project`` file,
+like so:
+
+.. code:: scheme
+
+          (lang dune 2.6)
+          (using bisect_ppx 1.0)
+
+Then, we should use the ``(bisect_ppx)`` field. The dune file may look like
+this:
+
+.. code:: scheme
+
+          (library
+           (name foo)
+           (modules foo)
+           (bisect_ppx))
+
+          (executable
+           (name test)
+           (modules test)
+           (libraries foo))
+
+The ``(bisect_ppx)`` field can be specified in library and executable stanzas.
+Libraries/executables that do not use ``(bisect_ppx)`` will not be instrumented
+for code coverage.
+
+Enabling/disabling code coverage
+================================
+
+By default, ``bisect_ppx`` is not compiled and linked with the program when
+using ``(bisect_ppx)``. To enable code coverage, we can set the
+``bisect_enabled``  flag in a ``dune-workspace`` file. For example,
+``dune-workspace.dev`` may look like:
+
+.. code:: scheme
+
+          (lang dune 2.6)
+          (context (default (bisect_enabled true)))
+
+Then, to build the project with code coverage, we can run:
+
+.. code:: bash
+
+          $ dune exec ./test.exe --workspace dune-workspace.dev
+
+We can also define different contexts in the ``dune-workspace`` file as follows:
+
+.. code:: scheme
+
+          (lang dune 2.6)
+          (context default)
+          (context (default (name coverage) (bisect_enabled true)))
+
+Running the following will enable coverage:
+
+.. code:: bash
+
+          $ dune exec ./test.exe --context coverage
+
+.. _bisect_ppx: https://github.com/aantron/bisect_ppx

doc/index.rst

@@ -15,6 +15,7 @@ Welcome to dune's documentation!
    dune-files
    concepts
    tests
+   bisect
    foreign-code
    documentation
    jsoo

src/dune/context.ml

@@ -256,7 +256,7 @@ let write_dot_dune_dir ~build_dir ~ocamlc ~ocaml_config_vars =
 
 let create ~(kind : Kind.t) ~path ~env ~env_nodes ~name ~merlin ~targets
     ~host_context ~host_toolchain ~profile ~fdo_target_exe
-    ~dynamically_linked_foreign_archives =
+    ~dynamically_linked_foreign_archives ~bisect_enabled =
   let prog_not_found_in_path prog =
     Utils.program_not_found prog ~context:name ~loc:None
   in
@@ -491,6 +491,7 @@ let create ~(kind : Kind.t) ~path ~env ~env_nodes ~name ~merlin ~targets
       ; ccomp_type = Ocaml_config.ccomp_type ocfg
       ; profile
       ; ocaml_version = Ocaml_config.version_string ocfg
+      ; bisect_enabled
       }
     in
     if Option.is_some fdo_target_exe then
@@ -603,10 +604,10 @@ let extend_paths t ~env =
   Env.extend ~vars env
 
 let default ~merlin ~env_nodes ~env ~targets ~fdo_target_exe
-    ~dynamically_linked_foreign_archives =
+    ~dynamically_linked_foreign_archives ~bisect_enabled =
   let path = Env.path env in
   create ~kind:Default ~path ~env ~env_nodes ~merlin ~targets ~fdo_target_exe
-    ~dynamically_linked_foreign_archives
+    ~dynamically_linked_foreign_archives ~bisect_enabled
 
 let opam_version =
   let f opam =
@@ -637,7 +638,7 @@ let opam_version =
 
 let create_for_opam ~root ~env ~env_nodes ~targets ~profile ~switch ~name
     ~merlin ~host_context ~host_toolchain ~fdo_target_exe
-    ~dynamically_linked_foreign_archives =
+    ~dynamically_linked_foreign_archives ~bisect_enabled =
   let opam =
     match Memo.Lazy.force opam with
     | None -> Utils.program_not_found "opam" ~loc:None
@@ -688,6 +689,7 @@ let create_for_opam ~root ~env ~env_nodes ~targets ~profile ~switch ~name
     ~kind:(Opam { root; switch })
     ~profile ~targets ~path ~env ~env_nodes ~name ~merlin ~host_context
     ~host_toolchain ~fdo_target_exe ~dynamically_linked_foreign_archives
+    ~bisect_enabled
 
 let instantiate_context env (workspace : Workspace.t)
     ~(context : Workspace.Context.t) ~host_context =
@@ -707,6 +709,7 @@ let instantiate_context env (workspace : Workspace.t)
       ; loc = _
       ; fdo_target_exe
       ; dynamically_linked_foreign_archives
+      ; bisect_enabled
       } ->
     let merlin =
       workspace.merlin_context = Some (Workspace.Context.name context)
@@ -722,6 +725,7 @@ let instantiate_context env (workspace : Workspace.t)
     let env = extend_paths ~env paths in
     default ~env ~env_nodes ~profile ~targets ~name ~merlin ~host_context
       ~host_toolchain ~fdo_target_exe ~dynamically_linked_foreign_archives
+      ~bisect_enabled
   | Opam
       { base =
           { targets
@@ -734,6 +738,7 @@ let instantiate_context env (workspace : Workspace.t)
           ; loc = _
           ; fdo_target_exe
           ; dynamically_linked_foreign_archives
+          ; bisect_enabled
           }
       ; switch
       ; root
@@ -742,7 +747,7 @@ let instantiate_context env (workspace : Workspace.t)
     let env = extend_paths ~env paths in
     create_for_opam ~root ~env_nodes ~env ~profile ~switch ~name ~merlin
       ~targets ~host_context ~host_toolchain:toolchain ~fdo_target_exe
-      ~dynamically_linked_foreign_archives
+      ~dynamically_linked_foreign_archives ~bisect_enabled
 
 module Create = struct
   module Output = struct

src/dune/dune_file.ml

@@ -35,6 +35,14 @@ let variants_field =
     (let* () = Dune_lang.Syntax.since library_variants (0, 1) in
      located (repeat Variant.decode >>| Variant.Set.of_list))
 
+let bisect_ppx_syntax =
+  Dune_lang.Syntax.create ~name:"bisect_ppx" ~desc:"the bisect_ppx extension"
+    [ ((1, 0), `Since (2, 6)) ]
+
+let () =
+  Dune_project.Extension.register_simple bisect_ppx_syntax
+    (Dune_lang.Decoder.return [])
+
 module Pps_and_flags = struct
   let decode =
     let+ l, flags =
@@ -214,6 +222,29 @@ module Preprocess_map = struct
         List.fold_left (Preprocess.pps pp) ~init:acc ~f:(fun acc (loc, pp) ->
             Lib_name.Map.set acc pp loc))
     |> Lib_name.Map.foldi ~init:[] ~f:(fun pp loc acc -> (loc, pp) :: acc)
+
+  let add_bisect t =
+    let bisect_ppx =
+      let bisect_name = Lib_name.parse_string_exn (Loc.none, "bisect_ppx") in
+      (Loc.none, bisect_name)
+    in
+    Per_module.map t ~f:(fun pp ->
+      match pp with
+      | Preprocess.No_preprocessing ->
+        let loc = Loc.none in
+        let pps = [ bisect_ppx ] in
+        let flags = [] in
+        let staged = false in
+        Preprocess.Pps { loc; pps; flags; staged }
+      | Preprocess.Pps { loc; pps; flags; staged } ->
+        let pps = bisect_ppx :: pps in
+        Preprocess.Pps { loc; pps; flags; staged }
+      | Action (loc, _) | Future_syntax loc ->
+        User_error.raise ~loc
+          [ Pp.text
+              "Preprocessing with actions and future syntax cannot be used \
+              in conjunction with (bisect_ppx)"
+          ])
 end
 
 module Lint = struct
@@ -359,6 +390,7 @@ module Buildable = struct
     ; flags : Ocaml_flags.Spec.t
     ; js_of_ocaml : Js_of_ocaml.t
     ; allow_overlapping_dependencies : bool
+    ; bisect_ppx : bool
     }
 
   let decode ~in_library ~allow_re_export =
@@ -424,6 +456,9 @@ module Buildable = struct
       field "js_of_ocaml" Js_of_ocaml.decode ~default:Js_of_ocaml.default
     and+ allow_overlapping_dependencies =
       field_b "allow_overlapping_dependencies"
+    and+ bisect_ppx =
+      field_b "bisect_ppx"
+        ~check:(Dune_lang.Syntax.since bisect_ppx_syntax (1, 0))
     and+ version = Dune_lang.Syntax.get_exn Stanza.syntax in
     let foreign_stubs =
       foreign_stubs
@@ -468,6 +503,7 @@ module Buildable = struct
     ; flags
     ; js_of_ocaml
     ; allow_overlapping_dependencies
+    ; bisect_ppx
     }
 
   let has_foreign t =
@@ -481,6 +517,12 @@ module Buildable = struct
         Per_module.get t.preprocess dummy_name
       else
         Preprocess.No_preprocessing
+
+  let preprocess t ~(lib_config: Lib_config.t) =
+    if t.bisect_ppx && lib_config.bisect_enabled then
+      Preprocess_map.add_bisect t.preprocess
+    else
+      t.preprocess
 end
 
 module Public_lib = struct
@@ -1031,7 +1073,17 @@ module Library = struct
     let synopsis = conf.synopsis in
     let sub_systems = conf.sub_systems in
     let ppx_runtime_deps = conf.ppx_runtime_libraries in
-    let pps = Preprocess_map.pps conf.buildable.preprocess in
+    let pps =
+      let pps_without_bisect = Preprocess_map.pps conf.buildable.preprocess in
+      if lib_config.bisect_enabled && conf.buildable.bisect_ppx then
+        let bisect_ppx =
+          let bisect_name = Lib_name.parse_string_exn (Loc.none, "bisect_ppx") in
+          (Loc.none, bisect_name)
+        in
+        bisect_ppx :: pps_without_bisect
+      else
+        pps_without_bisect
+    in
     let virtual_deps = conf.virtual_deps in
     let dune_version = Some conf.dune_version in
     let implements = conf.implements in

src/dune/dune_file.mli

@@ -98,13 +98,17 @@ module Buildable : sig
     ; flags : Ocaml_flags.Spec.t
     ; js_of_ocaml : Js_of_ocaml.t
     ; allow_overlapping_dependencies : bool
+    ; bisect_ppx : bool
     }
 
   (** Check if the buildable has any foreign stubs or archives. *)
   val has_foreign : t -> bool
 
   (** Preprocessing specification used by all modules or [No_preprocessing] *)
   val single_preprocess : t -> Preprocess.t
+
+  (** Includes bisect_ppx if specified by [lib_config] *)
+  val preprocess : t -> lib_config:Lib_config.t -> Preprocess_map.t
 end
 
 module Public_lib : sig

src/dune/exe_rules.ml

@@ -15,9 +15,13 @@ let executables_rules ~sctx ~dir ~expander ~dir_contents ~scope ~compile_info
     let ml_sources = Dir_contents.ocaml dir_contents in
     Ml_sources.modules_of_executables ml_sources ~first_exe ~obj_dir
   in
+  let ctx = SC.context sctx in
+  let preprocess =
+    Dune_file.Buildable.preprocess exes.buildable ~lib_config:ctx.lib_config
+  in
   let pp =
     Preprocessing.make sctx ~dir ~dep_kind:Required ~scope ~expander
-      ~preprocess:exes.buildable.preprocess
+      ~preprocess
       ~preprocessor_deps:exes.buildable.preprocessor_deps
       ~lint:exes.buildable.lint ~lib_name:None
   in
@@ -44,7 +48,6 @@ let executables_rules ~sctx ~dir ~expander ~dir_contents ~scope ~compile_info
                 (Module_name.to_string mod_name)
             ])
   in
-  let ctx = SC.context sctx in
   let explicit_js_mode = Dune_project.explicit_js_mode (Scope.project scope) in
   let linkages =
     let module L = Dune_file.Executables.Link_mode in
@@ -170,11 +173,14 @@ let executables_rules ~sctx ~dir ~expander ~dir_contents ~scope ~compile_info
 let rules ~sctx ~dir ~dir_contents ~scope ~expander
     (exes : Dune_file.Executables.t) =
   let dune_version = Scope.project scope |> Dune_project.dune_version in
+  let ctx = SC.context sctx in
+  let pps =
+    Dune_file.Preprocess_map.pps
+      (Dune_file.Buildable.preprocess exes.buildable ~lib_config:ctx.lib_config)
+  in
   let compile_info =
     Lib.DB.resolve_user_written_deps_for_exes (Scope.libs scope) exes.names
-      exes.buildable.libraries
-      ~pps:(Dune_file.Preprocess_map.pps exes.buildable.preprocess)
-      ~dune_version
+      exes.buildable.libraries ~pps ~dune_version
       ~allow_overlaps:exes.buildable.allow_overlapping_dependencies
       ~variants:exes.variants ~optional:exes.optional
       ~forbidden_libraries:exes.forbidden_libraries

src/dune/install_rules.ml

@@ -133,7 +133,7 @@ end = struct
             (Some loc, Install.Entry.make Stublibs a))
       ]
 
-  let keep_if ~external_lib_deps_mode expander =
+  let keep_if ~(ctx : Context.t) ~external_lib_deps_mode expander =
     if external_lib_deps_mode then
       fun ~scope:_ ->
     Option.some
@@ -155,10 +155,14 @@ end = struct
              let dune_version =
                Scope.project scope |> Dune_project.dune_version
              in
+             let pps =
+               Dune_file.Preprocess_map.pps
+                 (Dune_file.Buildable.preprocess exes.buildable
+                   ~lib_config:ctx.lib_config)
+             in
              Lib.DB.resolve_user_written_deps_for_exes (Scope.libs scope)
                exes.names exes.buildable.libraries
-               ~pps:(Dune_file.Preprocess_map.pps exes.buildable.preprocess)
-               ~dune_version
+               ~pps ~dune_version
                ~allow_overlaps:exes.buildable.allow_overlapping_dependencies
                ~variants:exes.variants ~optional:exes.optional
            in
@@ -231,7 +235,7 @@ end = struct
     in
     let keep_if =
       let external_lib_deps_mode = !Clflags.external_lib_deps_mode in
-      keep_if ~external_lib_deps_mode
+      keep_if ~ctx ~external_lib_deps_mode
     in
     Dir_with_dune.deep_fold stanzas ~init ~f:(fun d stanza acc ->
         let { Dir_with_dune.ctx_dir = dir; scope; _ } = d in

src/dune/lib_config.ml

@@ -14,6 +14,7 @@ type t =
   ; ccomp_type : Ocaml_config.Ccomp_type.t
   ; profile : Profile.t
   ; ocaml_version : string
+  ; bisect_enabled : bool
   }
 
 let var_map =

src/dune/lib_config.mli

@@ -14,6 +14,7 @@ type t =
   ; ccomp_type : Ocaml_config.Ccomp_type.t
   ; profile : Profile.t
   ; ocaml_version : string
+  ; bisect_enabled : bool
   }
 
 val allowed_in_enabled_if : (string * Dune_lang.Syntax.Version.t) list