refactor: do enabled if check once for test stanza (#11083)

Curently, we're doing it repeatedly for: * Every runtest mode * Every test executable Signed-off-by: Rudi Grinberg <me@rgrinberg.com>
ocaml · Nov 3, 2024 · e120e48 · e120e48
1 parent 90fa237
commit e120e48
Showing 1 changed file with 91 additions and 80 deletions.
diff --git 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
 ;;