Allow to declare (instrumentation) dependencies (#4210) (#4686)

Signed-off-by: Nicolás Ojeda Bär <[email protected]>

Co-authored-by: Emilio Jesús Gallego Arias <[email protected]>

CHANGES.md

@@ -3,6 +3,8 @@ unreleased - 2.9 branch
 
 - Add `(enabled_if ...)` to `(mdx ...)` (#4434, @emillon)
 
+- Add support for instrumentation dependencies (#4210, fixes #3983, @nojb)
+
 - Add the possibility to use `locks` with the cram tests stanza (#4480, @voodoos)
 
 - Allow to set up merlin in a variant of the default context

doc/instrumentation.rst

@@ -23,7 +23,8 @@ executable stanza:
    (library
     (name ...)
     (instrumentation
-     (backend <name> <args>)))
+     (backend <name> <args>)
+     <optional-fields>))
 
 The backend ``<name>`` can be passed arguments using ``<args>``.
 
@@ -50,6 +51,13 @@ At the moment, it is not possible to instrument code that is preprocessed via an
 action preprocessors. As these preprocessors are quite rare nowadays, there is
 no plan to add support for them in the future.
 
+``<optional-fields>`` are:
+
+- ``(deps <deps-conf list>)`` specifies extra dependencies of the
+  instrumentation, for instance if it reads a generated file. The dependencies
+  are only applied if the instrumentation is actually enabled. The specification
+  of dependencies is described in the :ref:`deps-field` section.
+
 Enabling/disabling instrumentation
 ==================================
 

src/dune_rules/cinaps.ml

@@ -81,7 +81,7 @@ let gen_rules sctx t ~dir ~scope =
     Preprocessing.make sctx ~dir ~expander ~dep_kind:Required
       ~lint:(Preprocess.Per_module.no_preprocessing ())
       ~preprocess:t.preprocess ~preprocessor_deps:t.preprocessor_deps
-      ~lib_name:None ~scope
+      ~instrumentation_deps:[] ~lib_name:None ~scope
   in
   let modules =
     Modules.singleton_exe module_

src/dune_rules/dune_file.ml

@@ -242,28 +242,35 @@ module Buildable = struct
         (multi_field "instrumentation"
            (Dune_lang.Syntax.since Stanza.syntax (2, 7)
            >>> fields
-                 (field "backend"
-                    (let+ libname = located Lib_name.decode
-                     and+ flags =
-                       let* current_ver =
-                         Dune_lang.Syntax.get_exn Stanza.syntax
+                 (let+ backend =
+                    field "backend"
+                      (let+ libname = located Lib_name.decode
+                       and+ flags =
+                         let* current_ver =
+                           Dune_lang.Syntax.get_exn Stanza.syntax
+                         in
+                         let version_check flag =
+                           let ver = (2, 8) in
+                           if current_ver >= ver then
+                             flag
+                           else
+                             let what =
+                               "The possibility to pass arguments to \
+                                instrumentation backends"
+                             in
+                             Dune_lang.Syntax.Error.since
+                               (String_with_vars.loc flag)
+                               Stanza.syntax ver ~what
+                         in
+                         repeat (String_with_vars.decode >>| version_check)
                        in
-                       let version_check flag =
-                         let ver = (2, 8) in
-                         if current_ver >= ver then
-                           flag
-                         else
-                           let what =
-                             "The possibility to pass arguments to \
-                              instrumentation backends"
-                           in
-                           Dune_lang.Syntax.Error.since
-                             (String_with_vars.loc flag)
-                             Stanza.syntax ver ~what
-                       in
-                       repeat (String_with_vars.decode >>| version_check)
-                     in
-                     (libname, flags)))))
+                       (libname, flags))
+                  and+ deps =
+                    field "deps" ~default:[]
+                      (Dune_lang.Syntax.since Stanza.syntax (2, 9)
+                      >>> repeat Dep_conf.decode)
+                  in
+                  (backend, deps))))
     and+ root_module =
       field_o "root_module"
         (Dune_lang.Syntax.since Stanza.syntax (2, 8) >>> Module_name.decode_loc)
@@ -274,9 +281,9 @@ module Buildable = struct
         Module_name.Per_item.map preprocess ~f:(Preprocess.map ~f)
       in
       List.fold_left instrumentation
-        ~f:(fun accu (instrumentation, flags) ->
+        ~f:(fun accu ((backend, flags), deps) ->
           Preprocess.Per_module.add_instrumentation accu
-            ~loc:loc_instrumentation ~flags instrumentation)
+            ~loc:loc_instrumentation ~flags ~deps backend)
         ~init
     in
     let foreign_stubs =

src/dune_rules/exe_rules.ml

@@ -100,13 +100,19 @@ let executables_rules ~sctx ~dir ~expander ~dir_contents ~scope ~compile_info
   Check_rules.add_obj_dir sctx ~obj_dir;
   let ctx = Super_context.context sctx in
   let pp =
+    let instrumentation_backend =
+      Lib.DB.instrumentation_backend (Scope.libs scope)
+    in
     let preprocess =
       Preprocess.Per_module.with_instrumentation exes.buildable.preprocess
-        ~instrumentation_backend:
-          (Lib.DB.instrumentation_backend (Scope.libs scope))
+        ~instrumentation_backend
+    in
+    let instrumentation_deps =
+      Preprocess.Per_module.instrumentation_deps exes.buildable.preprocess
+        ~instrumentation_backend
     in
     Preprocessing.make sctx ~dir ~dep_kind:Required ~scope ~expander ~preprocess
-      ~preprocessor_deps:exes.buildable.preprocessor_deps
+      ~preprocessor_deps:exes.buildable.preprocessor_deps ~instrumentation_deps
       ~lint:exes.buildable.lint ~lib_name:None
   in
   let modules =

src/dune_rules/lib_rules.ml

@@ -344,15 +344,21 @@ let cctx (lib : Library.t) ~sctx ~source_modules ~dir ~expander ~scope
   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 instrumentation_backend =
+    Lib.DB.instrumentation_backend (Scope.libs scope)
+  in
   let preprocess =
     Preprocess.Per_module.with_instrumentation lib.buildable.preprocess
-      ~instrumentation_backend:
-        (Lib.DB.instrumentation_backend (Scope.libs scope))
+      ~instrumentation_backend
+  in
+  let instrumentation_deps =
+    Preprocess.Per_module.instrumentation_deps lib.buildable.preprocess
+      ~instrumentation_backend
   in
   (* Preprocess before adding the alias module as it doesn't need preprocessing *)
   let pp =
     Preprocessing.make sctx ~dir ~dep_kind ~scope ~preprocess ~expander
-      ~preprocessor_deps:lib.buildable.preprocessor_deps
+      ~preprocessor_deps:lib.buildable.preprocessor_deps ~instrumentation_deps
       ~lint:lib.buildable.lint
       ~lib_name:(Some (snd lib.name))
   in

src/dune_rules/preprocess.ml

@@ -79,6 +79,14 @@ let filter_map t ~f =
       Pps { t with pps }
   | (No_preprocessing | Action _ | Future_syntax _) as t -> t
 
+let fold t ~init ~f =
+  match t with
+  | Pps t -> List.fold_left t.pps ~init ~f
+  | No_preprocessing
+  | Action _
+  | Future_syntax _ ->
+    init
+
 module Without_instrumentation = struct
   type t = Loc.t * Lib_name.t
 
@@ -88,7 +96,7 @@ end
 module With_instrumentation = struct
   type t =
     | Ordinary of Without_instrumentation.t
-    | Instrumentation_backend of (Loc.t * Lib_name.t)
+    | Instrumentation_backend of (Loc.t * Lib_name.t) * Dep_conf.t list
 end
 
 let decode =
@@ -197,16 +205,18 @@ module Per_module = struct
     else
       No_preprocessing
 
-  let add_instrumentation t ~loc ~flags:flags' libname =
+  let add_instrumentation t ~loc ~flags:flags' ~deps libname =
     Per_module.map t ~f:(fun pp ->
         match pp with
         | No_preprocessing ->
-          let pps = [ With_instrumentation.Instrumentation_backend libname ] in
+          let pps =
+            [ With_instrumentation.Instrumentation_backend (libname, deps) ]
+          in
           let staged = false in
           Pps { loc; pps; flags = flags'; staged }
         | Pps { loc; pps; flags; staged } ->
           let pps =
-            With_instrumentation.Instrumentation_backend libname :: pps
+            With_instrumentation.Instrumentation_backend (libname, deps) :: pps
           in
           Pps { loc; pps; flags = flags @ flags'; staged }
         | Action (loc, _)
@@ -227,8 +237,21 @@ module Per_module = struct
   let with_instrumentation t ~instrumentation_backend =
     let f = function
       | With_instrumentation.Ordinary libname -> Some libname
-      | With_instrumentation.Instrumentation_backend libname ->
+      | With_instrumentation.Instrumentation_backend (libname, _deps) ->
         instrumentation_backend libname
     in
     Per_module.map t ~f:(filter_map ~f)
+
+  let instrumentation_deps t ~instrumentation_backend =
+    let f = function
+      | With_instrumentation.Ordinary _ -> []
+      | With_instrumentation.Instrumentation_backend (libname, deps) -> (
+        match instrumentation_backend libname with
+        | Some _ -> deps
+        | None -> [])
+    in
+    Per_module.fold t ~init:[] ~f:(fun t init ->
+        let f acc t = f t :: acc in
+        fold t ~init ~f)
+    |> List.rev |> List.flatten
 end

src/dune_rules/preprocess.mli

@@ -29,7 +29,7 @@ end
 module With_instrumentation : sig
   type t =
     | Ordinary of Without_instrumentation.t
-    | Instrumentation_backend of (Loc.t * Lib_name.t)
+    | Instrumentation_backend of (Loc.t * Lib_name.t) * Dep_conf.t list
 end
 
 val decode : Without_instrumentation.t t Dune_lang.Decoder.t
@@ -78,6 +78,7 @@ module Per_module : sig
        With_instrumentation.t t
     -> loc:Loc.t
     -> flags:String_with_vars.t list
+    -> deps:Dep_conf.t list
     -> Loc.t * Lib_name.t
     -> With_instrumentation.t t
 
@@ -89,5 +90,11 @@ module Per_module : sig
     -> instrumentation_backend:
          (Loc.t * Lib_name.t -> Without_instrumentation.t option)
     -> Without_instrumentation.t t
+
+  val instrumentation_deps :
+       With_instrumentation.t t
+    -> instrumentation_backend:
+         (Loc.t * Lib_name.t -> Without_instrumentation.t option)
+    -> Dep_conf.t list
 end
 with type 'a preprocess := 'a t

src/dune_rules/preprocessing.ml

@@ -579,7 +579,8 @@ let lint_module sctx ~dir ~expander ~dep_kind ~lint ~lib_name ~scope =
        Module_name.Per_item.get lint (Module.name source) ~source ~ast)
 
 let make sctx ~dir ~expander ~dep_kind ~lint ~preprocess ~preprocessor_deps
-    ~lib_name ~scope =
+    ~instrumentation_deps ~lib_name ~scope =
+  let preprocessor_deps = preprocessor_deps @ instrumentation_deps in
   let preprocess =
     Module_name.Per_item.map preprocess ~f:(fun pp ->
         Preprocess.remove_future_syntax ~for_:Compiler pp

src/dune_rules/preprocessing.mli

@@ -12,6 +12,7 @@ val make :
   -> lint:Preprocess.Without_instrumentation.t Preprocess.Per_module.t
   -> preprocess:Preprocess.Without_instrumentation.t Preprocess.Per_module.t
   -> preprocessor_deps:Dep_conf.t list
+  -> instrumentation_deps:Dep_conf.t list
   -> lib_name:Lib_name.Local.t option
   -> scope:Scope.t
   -> Pp_spec.t

src/dune_rules/toplevel.ml

@@ -156,7 +156,7 @@ module Stanza = struct
     let preprocessing =
       Preprocessing.make sctx ~dir ~expander ~scope ~dep_kind:Required
         ~lib_name:None ~lint:Dune_file.Lint.no_lint ~preprocess
-        ~preprocessor_deps:[]
+        ~preprocessor_deps:[] ~instrumentation_deps:[]
     in
     let compile_info =
       let compiler_libs =

src/dune_rules/utop.ml

@@ -84,7 +84,7 @@ let setup sctx ~dir =
   let preprocessing =
     Preprocessing.make sctx ~dir ~expander ~scope ~dep_kind:Required
       ~lib_name:None ~lint:Dune_file.Lint.no_lint ~preprocess
-      ~preprocessor_deps:[]
+      ~preprocessor_deps:[] ~instrumentation_deps:[]
   in
   let source = source ~dir in
   let obj_dir = Toplevel.Source.obj_dir source in

test/blackbox-tests/test-cases/instrumentation.t/ppx/hello_ppx.ml

@@ -3,11 +3,27 @@ open Longident
 
 let place = ref None
 
+let file = ref None
+
+let read_file () =
+  match !file with
+  | None -> "<none>"
+  | Some s ->
+    let ic = open_in s in
+    begin match input_line ic with
+    | exception End_of_file ->
+      close_in ic;
+      "<none>"
+    | s ->
+      close_in ic;
+      s
+    end
+
 let impl str =
   let arg =
     match !place with
     | None -> Exp.ident (Location.mknoloc (Lident "__MODULE__"))
-    | Some s -> Exp.constant (Const.string s)
+    | Some s -> Exp.constant (Const.string (Printf.sprintf "%s (%s)" s (read_file ())))
   in
   Str.eval
     (Exp.apply (Exp.ident (Location.mknoloc (Ldot (Lident "Hello", "hello"))))
@@ -17,7 +33,9 @@ open Ppxlib
 
 let () =
   Driver.add_arg "-place" (Arg.String (fun s -> place := Some s))
-    ~doc:"PLACE where to say hello from"
+    ~doc:"PLACE where to say hello from";
+  Driver.add_arg "-file" (Arg.String (fun s -> file := Some s))
+    ~doc:"Add info from file"
 
 let () =
   Driver.register_transformation_using_ocaml_current_ast ~impl "hello"

test/blackbox-tests/test-cases/instrumentation.t/run.t

@@ -84,14 +84,40 @@ We also check that we can pass arguments to the ppx.
   > EOF
   $ dune build --instrument-with hello
   $ _build/default/main.exe
-  Hello from Spain!
+  Hello from Spain (<none>)!
+
+We also check that we can declare dependencies to the ppx.
+
+  $ mkdir -p input
+  $ cat >dune <<EOF
+  > (data_only_dirs input)
+  > (subdir input (rule (with-stdout-to input (echo "really"))))
+  > (executable
+  >  (name main)
+  >  (modules main)
+  >  (instrumentation (backend hello -place Spain -file input/input) (deps input/input)))
+  > EOF
+  $ dune build --instrument-with hello
+  File "dune", line 6, characters 65-83:
+  6 |  (instrumentation (backend hello -place Spain -file input/input) (deps input/input)))
+                                                                       ^^^^^^^^^^^^^^^^^^
+  Error: 'deps' is only available since version 2.9 of the dune language.
+  Please update your dune-project file to have (lang dune 2.9).
+  [1]
+
+  $ cat >dune-project <<EOF
+  > (lang dune 2.9)
+  > EOF
+  $ dune build --instrument-with hello
+  $ _build/default/main.exe
+  Hello from Spain (really)!
 
 Can also enable with an environment variable.
 
   $ DUNE_INSTRUMENT_WITH=hello dune build
 
   $ _build/default/main.exe
-  Hello from Spain!
+  Hello from Spain (really)!
 
 Instrumentation can also be controlled by using the dune-workspace file.
 
@@ -103,7 +129,7 @@ Instrumentation can also be controlled by using the dune-workspace file.
   $ dune build
 
   $ _build/default/main.exe
-  Hello from Spain!
+  Hello from Spain (really)!
 
 It can also be controlled on a per-context scope.
 
@@ -115,7 +141,7 @@ It can also be controlled on a per-context scope.
   $ dune build
 
   $ _build/coverage/main.exe
-  Hello from Spain!
+  Hello from Spain (really)!
 
 Per-context setting takes precedence over per-workspace setting.