From 87ec4656145069310b6b16bcc28f7845f902e009 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Wed, 23 Jun 2021 21:52:19 +0200 Subject: [PATCH] Bugfix: only add instrumentation flags if instrumentation enabled (#4770) (#4771) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * Use record type * instrumentation: only add flags if the instrumentation is active * CHANGES.md * Add test Signed-off-by: Nicolás Ojeda Bär --- CHANGES.md | 3 ++ src/dune_rules/preprocess.ml | 39 ++++++++++++------- src/dune_rules/preprocess.mli | 6 ++- .../test-cases/instrumentation.t/run.t | 12 +++++- .../instrumentation.t/trivial_ppx/dune | 6 +++ .../trivial_ppx/dune-project | 3 ++ .../trivial_ppx/trivial_ppx.ml | 4 ++ 7 files changed, 56 insertions(+), 17 deletions(-) create mode 100644 test/blackbox-tests/test-cases/instrumentation.t/trivial_ppx/dune create mode 100644 test/blackbox-tests/test-cases/instrumentation.t/trivial_ppx/dune-project create mode 100644 test/blackbox-tests/test-cases/instrumentation.t/trivial_ppx/trivial_ppx.ml diff --git a/CHANGES.md b/CHANGES.md index cae3c24e7d2..f2b0025c536 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -31,6 +31,9 @@ unreleased - 2.9 branch - 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) ------------------ diff --git a/src/dune_rules/preprocess.ml b/src/dune_rules/preprocess.ml index b0b136f1125..8e3dd9c9faa 100644 --- a/src/dune_rules/preprocess.ml +++ b/src/dune_rules/preprocess.ml @@ -73,10 +73,11 @@ let filter_map t ~f = match t with | Pps t -> let pps = 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 -> t let fold t ~init ~f = @@ -96,7 +97,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 = @@ -205,20 +210,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 @@ -229,23 +237,26 @@ module Per_module = struct let without_instrumentation t = let f = function - | With_instrumentation.Ordinary libname -> Some libname + | With_instrumentation.Ordinary libname -> Some (libname, []) | With_instrumentation.Instrumentation_backend _ -> None in Per_module.map t ~f:(filter_map ~f) let with_instrumentation t ~instrumentation_backend = let f = function - | With_instrumentation.Ordinary libname -> Some libname - | With_instrumentation.Instrumentation_backend (libname, _deps) -> - instrumentation_backend libname + | With_instrumentation.Ordinary libname -> Some (libname, []) + | With_instrumentation.Instrumentation_backend { libname; flags; _ } -> ( + match instrumentation_backend libname with + | None -> None + | Some backend -> Some (backend, flags)) 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) -> ( + | With_instrumentation.Instrumentation_backend + { libname; deps; flags = _ } -> ( match instrumentation_backend libname with | Some _ -> deps | None -> []) diff --git a/src/dune_rules/preprocess.mli b/src/dune_rules/preprocess.mli index f7aa94e6d90..9b64f879d0f 100644 --- a/src/dune_rules/preprocess.mli +++ b/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 diff --git a/test/blackbox-tests/test-cases/instrumentation.t/run.t b/test/blackbox-tests/test-cases/instrumentation.t/run.t index 3bdac80b754..f8a11ab51db 100644 --- a/test/blackbox-tests/test-cases/instrumentation.t/run.t +++ b/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 ()! +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 diff --git a/test/blackbox-tests/test-cases/instrumentation.t/trivial_ppx/dune b/test/blackbox-tests/test-cases/instrumentation.t/trivial_ppx/dune new file mode 100644 index 00000000000..8a4d57e1203 --- /dev/null +++ b/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)) diff --git a/test/blackbox-tests/test-cases/instrumentation.t/trivial_ppx/dune-project b/test/blackbox-tests/test-cases/instrumentation.t/trivial_ppx/dune-project new file mode 100644 index 00000000000..aa37e88ba6d --- /dev/null +++ b/test/blackbox-tests/test-cases/instrumentation.t/trivial_ppx/dune-project @@ -0,0 +1,3 @@ +(lang dune 2.7) + +(package (name trivial)) diff --git a/test/blackbox-tests/test-cases/instrumentation.t/trivial_ppx/trivial_ppx.ml b/test/blackbox-tests/test-cases/instrumentation.t/trivial_ppx/trivial_ppx.ml new file mode 100644 index 00000000000..b6a596ca183 --- /dev/null +++ b/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"