Enable bisect_ppx via dune-workspace

Signed-off-by: Stephanie You <[email protected]>

Author: stephanieyou

src/dune/context.ml

@@ -250,7 +250,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
@@ -485,6 +485,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
@@ -597,10 +598,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 =
@@ -631,7 +632,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
@@ -682,6 +683,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 =
@@ -701,6 +703,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)
@@ -716,6 +719,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
@@ -728,6 +732,7 @@ let instantiate_context env (workspace : Workspace.t)
           ; loc = _
           ; fdo_target_exe
           ; dynamically_linked_foreign_archives
+          ; bisect_enabled
           }
       ; switch
       ; root
@@ -736,7 +741,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

@@ -214,6 +214,24 @@ 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 }
+      | _ -> pp (* TODO: decide if this is the correct behavior *) )
 end
 
 module Lint = struct
@@ -359,6 +377,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 +443,8 @@ 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 Stanza.syntax (2, 5))
     and+ version = Dune_lang.Syntax.get_exn Stanza.syntax in
     let foreign_stubs =
       foreign_stubs
@@ -468,6 +489,7 @@ module Buildable = struct
     ; flags
     ; js_of_ocaml
     ; allow_overlapping_dependencies
+    ; bisect_ppx
     }
 
   let has_foreign t =
@@ -481,6 +503,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 +1059,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

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

src/dune/lib_rules.ml

@@ -340,10 +340,14 @@ let cctx (lib : Library.t) ~sctx ~source_modules ~dir ~expander ~scope
   let flags = Super_context.ocaml_flags sctx ~dir lib.buildable in
   let obj_dir = Library.obj_dir ~dir lib in
   let vimpl = Virtual_rules.impl sctx ~lib ~scope in
+  let ctx = Super_context.context sctx in
+  let preprocess =
+    Dune_file.Buildable.preprocess lib.buildable ~lib_config:ctx.lib_config
+  in
   (* Preprocess before adding the alias module as it doesn't need preprocessing *)
   let pp =
     Preprocessing.make sctx ~dir ~dep_kind ~scope
-      ~preprocess:lib.buildable.preprocess ~expander
+      ~preprocess ~expander
       ~preprocessor_deps:lib.buildable.preprocessor_deps
       ~lint:lib.buildable.lint
       ~lib_name:(Some (snd lib.name))
@@ -354,7 +358,6 @@ let cctx (lib : Library.t) ~sctx ~source_modules ~dir ~expander ~scope
   let modules = Vimpl.impl_modules vimpl modules in
   let requires_compile = Lib.Compile.direct_requires compile_info in
   let requires_link = Lib.Compile.requires_link compile_info in
-  let ctx = Super_context.context sctx in
   let dynlink =
     Dynlink_supported.get lib.dynlink ctx.supports_shared_libraries
   in

src/dune/workspace.ml

@@ -49,6 +49,7 @@ module Context = struct
       ; paths : (string * Ordered_set_lang.t) list
       ; fdo_target_exe : Path.t option
       ; dynamically_linked_foreign_archives : bool
+      ; bisect_enabled : bool
       }
 
     let to_dyn = Dyn.Encoder.opaque
@@ -64,6 +65,7 @@ module Context = struct
         ; paths
         ; fdo_target_exe
         ; dynamically_linked_foreign_archives
+        ; bisect_enabled
         } t =
       Profile.equal profile t.profile
       && List.equal Target.equal targets t.targets
@@ -77,6 +79,7 @@ module Context = struct
       && Option.equal Path.equal fdo_target_exe t.fdo_target_exe
       && Bool.equal dynamically_linked_foreign_archives
            t.dynamically_linked_foreign_archives
+      && Bool.equal bisect_enabled t.bisect_enabled
 
     let fdo_suffix t =
       match t.fdo_target_exe with
@@ -133,6 +136,9 @@ module Context = struct
         field "paths" ~default:[]
           ( Dune_lang.Syntax.since Stanza.syntax (1, 12)
           >>> map ~f (repeat (pair (located string) Ordered_set_lang.decode)) )
+      and+ bisect_enabled =
+          field ~default:false "bisect_enabled"
+            (Dune_lang.Syntax.since syntax (2, 5) >>> bool)
       and+ loc = loc in
       Option.iter host_context ~f:(fun _ ->
           match targets with
@@ -153,6 +159,7 @@ module Context = struct
       ; paths
       ; fdo_target_exe
       ; dynamically_linked_foreign_archives
+      ; bisect_enabled
       }
   end
 
@@ -293,6 +300,7 @@ module Context = struct
       ; paths = []
       ; fdo_target_exe = None
       ; dynamically_linked_foreign_archives = true
+      ; bisect_enabled = false
       }
 end
 

src/dune/workspace.mli

@@ -28,6 +28,7 @@ module Context : sig
                 will be built with all foreign archives statically linked into
                 the runtime system. *)
       ; dynamically_linked_foreign_archives : bool
+      ; bisect_enabled : bool
       }
   end
 

test/blackbox-tests/dune.inc

@@ -46,6 +46,14 @@
    test-cases/bin-eager-deps
    (progn (run dune-cram run run.t) (diff? run.t run.t.corrected)))))
 
+(rule
+ (alias bisect-ppx)
+ (deps (package dune) (source_tree test-cases/bisect-ppx))
+ (action
+  (chdir
+   test-cases/bisect-ppx
+   (progn (run dune-cram run run.t) (diff? run.t run.t.corrected)))))
+
 (rule
  (alias block-strings)
  (deps (package dune) (source_tree test-cases/block-strings))
@@ -2458,6 +2466,7 @@
   (alias all-promotions)
   (alias bad-alias-error)
   (alias bin-eager-deps)
+  (alias bisect-ppx)
   (alias block-strings)
   (alias byte-code-only)
   (alias byte_complete)
@@ -2750,6 +2759,7 @@
   (alias all-promotions)
   (alias bad-alias-error)
   (alias bin-eager-deps)
+  (alias bisect-ppx)
   (alias block-strings)
   (alias byte-code-only)
   (alias byte_complete)

test/blackbox-tests/gen_tests.ml

@@ -255,6 +255,7 @@ let exclusions =
       ~additional_deps:[ Sexp.strings [ "package"; "dune-configurator" ] ]
   ; make "mdx-stanza" ~external_deps:true
   ; make "toplevel-integration" ~external_deps:true
+  ; make "bisect-ppx"
   ]
   |> String_map.of_list_map_exn ~f:(fun (test : Test.t) -> (test.path, test))
 

test/blackbox-tests/test-cases/bisect-ppx/dune

@@ -0,0 +1,9 @@
+(library
+  (name hello)
+  (modules hello)
+  (bisect_ppx))
+
+(executable
+  (name tester)
+  (modules tester)
+  (libraries hello))

test/blackbox-tests/test-cases/bisect-ppx/dune-project

@@ -0,0 +1 @@
+(lang dune 2.5)

test/blackbox-tests/test-cases/bisect-ppx/dune-workspace

@@ -0,0 +1,2 @@
+(lang dune 2.5)
+(context (default (bisect_enabled false)))

test/blackbox-tests/test-cases/bisect-ppx/dune-workspace.dev

@@ -0,0 +1,2 @@
+(lang dune 2.5)
+(context (default (bisect_enabled true)))

test/blackbox-tests/test-cases/bisect-ppx/hello.ml

@@ -0,0 +1 @@
+let run () = print_endline "Hello, world!"

test/blackbox-tests/test-cases/bisect-ppx/run.t

@@ -0,0 +1,11 @@
+Test that bisect_ppx is enabled and produces *.coverage file.
+  $ dune exec --root . ./tester.exe
+  Hello, world!
+  $ dune exec bisect-ppx-report -- html
+  Error: no coverage files given on command line or found
+  [1]
+  $ dune exec --root . ./tester.exe --workspace dune-workspace.dev
+  Hello, world!
+  $ dune exec bisect-ppx-report -- html
+  Info: found coverage files in './'
+

test/blackbox-tests/test-cases/bisect-ppx/tester.ml

@@ -0,0 +1,2 @@
+let () =
+  Hello.run ()

test/expect-tests/findlib_tests.ml

@@ -28,6 +28,7 @@ let findlib =
     ; ccomp_type = Other "gcc"
     ; profile = Profile.Dev
     ; ocaml_version = "4.02.3"
+    ; bisect_enabled = false
     }
   in
   Findlib.create ~stdlib_dir:cwd ~paths:[ db_path ]