Bugfix: only add instrumentation flags if instrumentation enabled (#4770

)

* Use record type
* instrumentation: only add flags if the instrumentation is active
* CHANGES.md
* Add test

Signed-off-by: Nicolás Ojeda Bär <n.oje.bar@gmail.com>

CHANGES.md

@@ -188,6 +188,9 @@ Unreleased
 - Disable some warnings on Coq 8.14 and `(lang coq (>= 0.3))` due to
   the rework of the Coq "native" compilation system (#4760, @ejgallego)
 
+- Fix a bug where instrumentation flags would be added even if the
+  instrumentatation was disabled (@nojb, #4770)
+
 2.8.5 (28/03/2021)
 ------------------
 

src/dune_rules/preprocess.ml

@@ -84,10 +84,11 @@ let filter_map_resolve t ~f =
   match t with
   | Pps t ->
     let+ pps = Resolve.List.filter_map t.pps ~f in
+    let pps, flags = List.split pps in
     if pps = [] then
       No_preprocessing
     else
-      Pps { t with pps }
+      Pps { t with pps; flags = t.flags @ List.flatten flags }
   | (No_preprocessing | Action _ | Future_syntax _) as t -> Resolve.return t
 
 let fold_resolve t ~init ~f =
@@ -107,7 +108,11 @@ end
 module With_instrumentation = struct
   type t =
     | Ordinary of Without_instrumentation.t
-    | Instrumentation_backend of (Loc.t * Lib_name.t) * Dep_conf.t list
+    | Instrumentation_backend of
+        { libname : Loc.t * Lib_name.t
+        ; deps : Dep_conf.t list
+        ; flags : String_with_vars.t list
+        }
 end
 
 let decode =
@@ -224,20 +229,23 @@ module Per_module = struct
     else
       No_preprocessing
 
-  let add_instrumentation t ~loc ~flags:flags' ~deps libname =
+  let add_instrumentation t ~loc ~flags ~deps libname =
     Per_module.map t ~f:(fun pp ->
         match pp with
         | No_preprocessing ->
           let pps =
-            [ With_instrumentation.Instrumentation_backend (libname, deps) ]
+            [ With_instrumentation.Instrumentation_backend
+                { libname; deps; flags }
+            ]
           in
-          let staged = false in
-          Pps { loc; pps; flags = flags'; staged }
-        | Pps { loc; pps; flags; staged } ->
+          Pps { loc; pps; flags = []; staged = false }
+        | Pps ({ pps; _ } as t) ->
           let pps =
-            With_instrumentation.Instrumentation_backend (libname, deps) :: pps
+            With_instrumentation.Instrumentation_backend
+              { libname; deps; flags }
+            :: pps
           in
-          Pps { loc; pps; flags = flags @ flags'; staged }
+          Pps { t with pps }
         | Action (loc, _)
         | Future_syntax loc ->
           User_error.raise ~loc
@@ -255,17 +263,24 @@ module Per_module = struct
 
   let with_instrumentation t ~instrumentation_backend =
     let f = function
-      | With_instrumentation.Ordinary libname -> Resolve.return (Some libname)
-      | With_instrumentation.Instrumentation_backend (libname, _deps) ->
-        instrumentation_backend libname
+      | With_instrumentation.Ordinary libname ->
+        Resolve.return (Some (libname, []))
+      | With_instrumentation.Instrumentation_backend { libname; flags; _ } ->
+        Resolve.map
+          ~f:(fun backend ->
+            match backend with
+            | None -> None
+            | Some backend -> Some (backend, flags))
+          (instrumentation_backend libname)
     in
     Per_module.map_resolve t ~f:(filter_map_resolve ~f)
 
   let instrumentation_deps t ~instrumentation_backend =
     let open Resolve.O in
     let f = function
       | With_instrumentation.Ordinary _ -> Resolve.return []
-      | With_instrumentation.Instrumentation_backend (libname, deps) -> (
+      | With_instrumentation.Instrumentation_backend
+          { libname; deps; flags = _ } -> (
         instrumentation_backend libname >>| function
         | Some _ -> deps
         | None -> [])

src/dune_rules/preprocess.mli

@@ -29,7 +29,11 @@ end
 module With_instrumentation : sig
   type t =
     | Ordinary of Without_instrumentation.t
-    | Instrumentation_backend of (Loc.t * Lib_name.t) * Dep_conf.t list
+    | Instrumentation_backend of
+        { libname : Loc.t * Lib_name.t
+        ; deps : Dep_conf.t list
+        ; flags : String_with_vars.t list
+        }
 end
 
 val decode : Without_instrumentation.t t Dune_lang.Decoder.t

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

@@ -68,11 +68,12 @@ We also check that we can pass arguments to the ppx.
   > (executable
   >  (name main)
   >  (modules main)
+  >  (preprocess (pps trivial.ppx))
   >  (instrumentation (backend hello -place Spain)))
   > EOF
   $ dune build --instrument-with hello
-  File "dune", line 4, characters 33-39:
-  4 |  (instrumentation (backend hello -place Spain)))
+  File "dune", line 5, characters 33-39:
+  5 |  (instrumentation (backend hello -place Spain)))
                                        ^^^^^^
   Error: The possibility to pass arguments to instrumentation backends is only
   available since version 2.8 of the dune language. Please update your
@@ -86,6 +87,13 @@ We also check that we can pass arguments to the ppx.
   $ _build/default/main.exe
   Hello from Spain (<none>)!
 
+Check that we do not pass the instrumentation flags when the instrumentation is
+disabled. If the flags were passed with the instrumentation disabled, the
+following command would fail (as the flags would be passed to the "trivial"
+ppx).
+
+  $ dune build
+
 We also check that we can declare dependencies to the ppx.
 
   $ mkdir -p input

test/blackbox-tests/test-cases/instrumentation.t/trivial_ppx/dune

@@ -0,0 +1,6 @@
+(library
+ (name trivial_ppx)
+ (public_name trivial.ppx)
+ (kind ppx_rewriter)
+ (libraries ppxlib)
+ (modules trivial_ppx))

test/blackbox-tests/test-cases/instrumentation.t/trivial_ppx/dune-project

@@ -0,0 +1,3 @@
+(lang dune 2.7)
+
+(package (name trivial))

test/blackbox-tests/test-cases/instrumentation.t/trivial_ppx/trivial_ppx.ml

@@ -0,0 +1,4 @@
+open Ppxlib
+
+let () =
+  Driver.register_transformation_using_ocaml_current_ast ~impl:Fun.id "trivial"