From 08f72f417071b6aca6ae009e867c322939eb0e7d Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sat, 2 Nov 2024 23:55:04 +0000 Subject: [PATCH] refactor: do enabled if check once for test stanza Curently, we're doing it repeatedly for: * Every runtest mode * Every test executable Signed-off-by: Rudi Grinberg Signed-off-by: Rudi Grinberg --- src/dune_rules/test_rules.ml | 171 +++++++++++++++++++---------------- 1 file changed, 91 insertions(+), 80 deletions(-) diff --git a/src/dune_rules/test_rules.ml b/src/dune_rules/test_rules.ml index b4b7296fe0f..a1f84a9e021 100644 --- a/src/dune_rules/test_rules.ml +++ b/src/dune_rules/test_rules.ml @@ -1,5 +1,11 @@ open Import +let alias mode ~dir = + match mode with + | `js -> Jsoo_rules.js_of_ocaml_runtest_alias ~dir + | `exe | `bc -> Memo.return Alias0.runtest +;; + let rules (t : Tests.t) ~sctx ~dir ~scope ~expander ~dir_contents = let test_kind (loc, name, ext) = let files = Dir_contents.text_files dir_contents in @@ -32,89 +38,94 @@ let rules (t : Tests.t) ~sctx ~dir ~scope ~expander ~dir_contents = |> List.sort_uniq ~compare:Poly.compare in let* () = - Nonempty_list.to_list t.exes.names - |> Memo.parallel_iter ~f:(fun (loc, s) -> - Memo.parallel_iter runtest_modes ~f:(fun runtest_mode -> - let ext = - match runtest_mode with - | `js -> Js_of_ocaml.Ext.exe - | `bc -> ".bc" - | `exe -> ".exe" - in - let custom_runner = - match runtest_mode with - | `js -> Some Jsoo_rules.runner - | `bc | `exe -> None - in - let test_pform = Pform.Var Test in - let run_action = - match t.action with - | Some a -> a - | None -> - (match custom_runner with - | None -> - Action_unexpanded.run (String_with_vars.make_pform loc test_pform) [] - | Some runner -> - Action_unexpanded.run - (String_with_vars.make_text loc runner) - [ String_with_vars.make_pform loc test_pform ]) - in - let test_exe = s ^ ext in - let extra_bindings = - let test_exe_path = - Expander.map_exe expander (Path.relative (Path.build dir) test_exe) + Expander.eval_blang expander t.enabled_if + >>= function + | false -> + let loc = Nonempty_list.hd t.exes.names |> fst in + Memo.parallel_iter runtest_modes ~f:(fun mode -> + let* alias_name = alias mode ~dir in + let alias = Alias.make alias_name ~dir in + Simple_rules.Alias_rules.add_empty sctx ~loc ~alias) + | true -> + Nonempty_list.to_list t.exes.names + |> Memo.parallel_iter ~f:(fun (loc, s) -> + Memo.parallel_iter runtest_modes ~f:(fun runtest_mode -> + let ext = + match runtest_mode with + | `js -> Js_of_ocaml.Ext.exe + | `bc -> ".bc" + | `exe -> ".exe" + in + let custom_runner = + match runtest_mode with + | `js -> Some Jsoo_rules.runner + | `bc | `exe -> None + in + let test_pform = Pform.Var Test in + let run_action = + match t.action with + | Some a -> a + | None -> + (match custom_runner with + | None -> + Action_unexpanded.run (String_with_vars.make_pform loc test_pform) [] + | Some runner -> + Action_unexpanded.run + (String_with_vars.make_text loc runner) + [ String_with_vars.make_pform loc test_pform ]) + in + let test_exe = s ^ ext in + let extra_bindings = + let test_exe_path = + Expander.map_exe expander (Path.relative (Path.build dir) test_exe) + in + Pform.Map.singleton test_pform [ Value.Path test_exe_path ] in - Pform.Map.singleton test_pform [ Value.Path test_exe_path ] - in - let* runtest_alias = - match runtest_mode with - | `js -> Jsoo_rules.js_of_ocaml_runtest_alias ~dir - | `exe | `bc -> Memo.return Alias0.runtest - in - let deps = - match custom_runner with - | Some _ -> - Bindings.Unnamed (Dep_conf.File (String_with_vars.make_text loc test_exe)) - :: t.deps - | None -> t.deps - in - let add_alias ~loc ~action = - (* CR rgrinberg: why are we going through the stanza api? *) - let alias = - { Alias_conf.name = runtest_alias - ; locks = t.locks - ; package = t.package - ; deps - ; action = Some (loc, action) - ; enabled_if = t.enabled_if - ; loc - } + let* runtest_alias = alias runtest_mode ~dir in + let deps = + match custom_runner with + | Some _ -> + Bindings.Unnamed (Dep_conf.File (String_with_vars.make_text loc test_exe)) + :: t.deps + | None -> t.deps in - Simple_rules.alias sctx ~extra_bindings ~dir ~expander alias - in - match test_kind (loc, s, ext) with - | `Regular -> add_alias ~loc ~action:run_action - | `Expect diff -> - let rule = - { Rule_conf.targets = Infer - ; deps - ; action = - ( loc - , Action_unexpanded.Redirect_out (Stdout, diff.file2, Normal, run_action) - ) - ; mode = Standard - ; locks = t.locks - ; loc - ; enabled_if = t.enabled_if - ; aliases = [] - ; package = t.package - } + let add_alias ~loc ~action = + (* CR rgrinberg: why are we going through the stanza api? *) + let alias = + { Alias_conf.name = runtest_alias + ; locks = t.locks + ; package = t.package + ; deps + ; action = Some (loc, action) + ; enabled_if = t.enabled_if + ; loc + } + in + Simple_rules.alias sctx ~extra_bindings ~dir ~expander alias in - add_alias ~loc ~action:(Diff diff) - >>> let+ (_ignored_targets : Targets.Validated.t option) = - Simple_rules.user_rule sctx rule ~extra_bindings ~dir ~expander - in - ())) + match test_kind (loc, s, ext) with + | `Regular -> add_alias ~loc ~action:run_action + | `Expect diff -> + let rule = + { Rule_conf.targets = Infer + ; deps + ; action = + ( loc + , Action_unexpanded.Redirect_out (Stdout, diff.file2, Normal, run_action) + ) + ; mode = Standard + ; locks = t.locks + ; loc + ; enabled_if = t.enabled_if + ; aliases = [] + ; package = t.package + } + in + add_alias ~loc ~action:(Diff diff) + >>> let+ (_ignored_targets : Targets.Validated.t option) = + Simple_rules.user_rule sctx rule ~extra_bindings ~dir ~expander + in + ())) in Exe_rules.rules t.exes ~sctx ~dir ~scope ~expander ~dir_contents ;;