From 60ffa0da90ac9e772e147e8d02d4b74f8079ad06 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sun, 18 Aug 2024 12:46:34 +0700 Subject: [PATCH] refactor: move [System] to be a custom action Signed-off-by: Rudi Grinberg --- bin/print_rules.ml | 1 - src/dune_engine/action.ml | 4 -- src/dune_engine/action_exec.ml | 6 --- src/dune_engine/action_intf.ml | 2 - src/dune_engine/action_mapper.ml | 1 - src/dune_engine/action_to_sh.ml | 1 - src/dune_engine/build_system.ml | 4 +- src/dune_rules/action_unexpanded.ml | 2 +- src/dune_rules/pkg_rules.ml | 7 ++- src/dune_rules/system.ml | 45 +++++++++++++++++++ src/dune_rules/system.mli | 5 +++ .../test-cases/dune-cache/mode-copy.t | 4 +- .../test-cases/dune-cache/mode-hardlink.t | 4 +- .../test-cases/dune-cache/repro-check.t | 6 +-- .../test-cases/dune-cache/trim.t | 4 +- .../dune_engine/action_to_sh_tests.ml | 6 --- 16 files changed, 65 insertions(+), 37 deletions(-) create mode 100644 src/dune_rules/system.ml create mode 100644 src/dune_rules/system.mli diff --git a/bin/print_rules.ml b/bin/print_rules.ml index 40389c204c9..beef4f5e882 100644 --- a/bin/print_rules.ml +++ b/bin/print_rules.ml @@ -91,7 +91,6 @@ let rec encode : Action.For_shell.t -> Dune_lang.t = | Copy (x, y) -> List [ atom "copy"; path x; target y ] | Symlink (x, y) -> List [ atom "symlink"; path x; target y ] | Hardlink (x, y) -> List [ atom "hardlink"; path x; target y ] - | System x -> List [ atom "system"; string x ] | Bash x -> List [ atom "bash"; string x ] | Write_file (x, perm, y) -> List [ atom ("write-file" ^ File_perm.suffix perm); target x; string y ] diff --git a/src/dune_engine/action.ml b/src/dune_engine/action.ml index 0be96c0e869..2762e900fce 100644 --- a/src/dune_engine/action.ml +++ b/src/dune_engine/action.ml @@ -49,7 +49,6 @@ struct let cat ps = Cat ps let copy a b = Copy (a, b) let symlink a b = Symlink (a, b) - let system s = System s let bash s = Bash s let write_file ?(perm = File_perm.Normal) p s = Write_file (p, perm, s) let rename a b = Rename (a, b) @@ -189,7 +188,6 @@ let fold_one_step t ~init:acc ~f = | Copy _ | Symlink _ | Hardlink _ - | System _ | Bash _ | Write_file _ | Rename _ @@ -230,7 +228,6 @@ let rec is_dynamic = function | With_accepted_exit_codes (_, t) -> is_dynamic t | Progn l | Pipe (_, l) | Concurrent l -> List.exists l ~f:is_dynamic | Run _ - | System _ | Bash _ | Echo _ | Cat _ @@ -292,7 +289,6 @@ let is_useful_to memoize = | Mkdir _ -> false | Run _ -> true | Dynamic_run _ -> true - | System _ -> true | Bash _ -> true | Extension (module A) -> A.Spec.is_useful_to ~memoize in diff --git a/src/dune_engine/action_exec.ml b/src/dune_engine/action_exec.ml index adb48aa5e2a..77a271e8775 100644 --- a/src/dune_engine/action_exec.ml +++ b/src/dune_engine/action_exec.ml @@ -236,12 +236,6 @@ let rec exec t ~display ~ectx ~eenv : done_or_more_deps Produce.t = | Hardlink (src, dst) -> let+ () = maybe_async (fun () -> Io.portable_hardlink ~src ~dst:(Path.build dst)) in Done - | System cmd -> - let path, arg = - Dune_util.Prog.system_shell_exn ~needed_to:"interpret (system ...) actions" - in - let+ () = exec_run ~display ~ectx ~eenv path [ arg; cmd ] in - Done | Bash cmd -> let+ () = exec_run diff --git a/src/dune_engine/action_intf.ml b/src/dune_engine/action_intf.ml index e330c11d0e2..8669f91c90f 100644 --- a/src/dune_engine/action_intf.ml +++ b/src/dune_engine/action_intf.ml @@ -44,7 +44,6 @@ module type Ast = sig | Copy of path * target | Symlink of path * target | Hardlink of path * target - | System of string | Bash of string | Write_file of target * File_perm.t * string | Rename of target * target @@ -78,7 +77,6 @@ module type Helpers = sig val cat : path list -> t val copy : path -> target -> t val symlink : path -> target -> t - val system : string -> t val bash : string -> t val write_file : ?perm:File_perm.t -> target -> string -> t val rename : target -> target -> t diff --git a/src/dune_engine/action_mapper.ml b/src/dune_engine/action_mapper.ml index ae02a98c953..d6f680ff5b5 100644 --- a/src/dune_engine/action_mapper.ml +++ b/src/dune_engine/action_mapper.ml @@ -34,7 +34,6 @@ module Make (Src : Action_intf.Ast) (Dst : Action_intf.Ast) = struct | Copy (x, y) -> Copy (f_path ~dir x, f_target ~dir y) | Symlink (x, y) -> Symlink (f_path ~dir x, f_target ~dir y) | Hardlink (x, y) -> Hardlink (f_path ~dir x, f_target ~dir y) - | System x -> System (f_string ~dir x) | Bash x -> Bash (f_string ~dir x) | Write_file (x, perm, y) -> Write_file (f_target ~dir x, perm, f_string ~dir y) | Rename (x, y) -> Rename (f_target ~dir x, f_target ~dir y) diff --git a/src/dune_engine/action_to_sh.ml b/src/dune_engine/action_to_sh.ml index 1b76620f61c..471a17f454c 100644 --- a/src/dune_engine/action_to_sh.ml +++ b/src/dune_engine/action_to_sh.ml @@ -62,7 +62,6 @@ let simplify act = | Copy (x, y) -> Run ("cp", [ x; y ]) :: acc | Symlink (x, y) -> Run ("ln", [ "-s"; x; y ]) :: Run ("rm", [ "-f"; y ]) :: acc | Hardlink (x, y) -> Run ("ln", [ x; y ]) :: Run ("rm", [ "-f"; y ]) :: acc - | System x -> Sh x :: acc | Bash x -> Run ("bash", [ "-e"; "-u"; "-o"; "pipefail"; "-c"; x ]) :: acc | Write_file (x, perm, y) -> interpret_perm perm x (Redirect_out (echo y, Stdout, File x) :: acc) diff --git a/src/dune_engine/build_system.ml b/src/dune_engine/build_system.ml index 5fa83350947..7cb8e92c139 100644 --- a/src/dune_engine/build_system.ml +++ b/src/dune_engine/build_system.ml @@ -245,7 +245,7 @@ end = struct (* The current version of the rule digest scheme. We should increment it when making any changes to the scheme, to avoid collisions. *) - let rule_digest_version = 21 + let rule_digest_version = 22 let compute_rule_digest (rule : Rule.t) @@ -722,7 +722,7 @@ end = struct (* The current version of the action digest scheme. We should increment it when making any changes to the scheme, to avoid collisions. *) - let action_digest_version = 1 + let action_digest_version = 2 let execute_action_generic ~observing_facts diff --git a/src/dune_rules/action_unexpanded.ml b/src/dune_rules/action_unexpanded.ml index 275cef80ad1..3b40d432cb6 100644 --- a/src/dune_rules/action_unexpanded.ml +++ b/src/dune_rules/action_unexpanded.ml @@ -522,7 +522,7 @@ let rec expand (t : Dune_lang.Action.t) : Action.t Action_expander.t = Copy_line_directive.action context ~src:x ~dst:y)) | System x -> let+ x = E.string x in - O.System x + System.action x | Bash x -> let+ x = E.string x in O.Bash x diff --git a/src/dune_rules/pkg_rules.ml b/src/dune_rules/pkg_rules.ml index 5faf43a8e3c..0643995b86b 100644 --- a/src/dune_rules/pkg_rules.ml +++ b/src/dune_rules/pkg_rules.ml @@ -958,10 +958,9 @@ module Action_expander = struct let+ args = Memo.parallel_map t ~f:(expand ~expander) in Action.Progn args | System arg -> - let+ arg = - Expander.expand_pform_gen ~mode:Single expander arg >>| Value.to_string ~dir - in - Action.System arg + Expander.expand_pform_gen ~mode:Single expander arg + >>| Value.to_string ~dir + >>| System.action | Patch p -> let+ patch = Expander.expand_pform_gen ~mode:Single expander p >>| Value.to_path ~dir diff --git a/src/dune_rules/system.ml b/src/dune_rules/system.ml new file mode 100644 index 00000000000..df772feae4b --- /dev/null +++ b/src/dune_rules/system.ml @@ -0,0 +1,45 @@ +open Import +open Fiber.O + +module Spec = struct + type (_, _) t = string + + let name = "system" + let version = 1 + let bimap t _ _ = t + let is_useful_to ~memoize = memoize + let encode cmd _ _ : Sexp.t = List [ Atom name; Atom cmd ] + + let action cmd ~(ectx : Action.context) ~(eenv : Action.env) = + let prog, arg = + Dune_util.Prog.system_shell_exn ~needed_to:"interpret (system ...) actions" + in + let display = !Clflags.display in + Process.run + (Accept eenv.exit_codes) + prog + [ arg; cmd ] + ~display + ~metadata:ectx.metadata + ~stdout_to:eenv.stdout_to + ~stderr_to:eenv.stderr_to + ~stdin_from:eenv.stdin_from + ~dir:eenv.working_dir + ~env:eenv.env + >>| function + | Error _ -> () + | Ok s -> s + ;; +end + +let action cmd = + Action.Extension + (module struct + type path = Path.t + type target = Path.Build.t + + module Spec = Spec + + let v = cmd + end) +;; diff --git a/src/dune_rules/system.mli b/src/dune_rules/system.mli new file mode 100644 index 00000000000..2cd6b24b695 --- /dev/null +++ b/src/dune_rules/system.mli @@ -0,0 +1,5 @@ +(** The system action runs [/bin/sh] *) + +open Import + +val action : string -> Action.t diff --git a/test/blackbox-tests/test-cases/dune-cache/mode-copy.t b/test/blackbox-tests/test-cases/dune-cache/mode-copy.t index ea565d9d18b..a12664fd980 100644 --- a/test/blackbox-tests/test-cases/dune-cache/mode-copy.t +++ b/test/blackbox-tests/test-cases/dune-cache/mode-copy.t @@ -40,9 +40,9 @@ never built [target1] before. $ dune build --config-file=config target1 --debug-cache=shared,workspace-local \ > 2>&1 | grep '_build/default/source\|_build/default/target' Workspace-local cache miss: _build/default/source: never seen this target before - Shared cache miss [13c77218604dc994750d09a29ee8afbc] (_build/default/source): not found in cache + Shared cache miss [14310d25a9f1419e568e561a619c1aba] (_build/default/source): not found in cache Workspace-local cache miss: _build/default/target1: never seen this target before - Shared cache miss [20702b179e0171aac33d40d83f666fc2] (_build/default/target1): not found in cache + Shared cache miss [859bfe7523c5c00a35ba163f44225971] (_build/default/target1): not found in cache $ dune_cmd stat hardlinks _build/default/source 1 diff --git a/test/blackbox-tests/test-cases/dune-cache/mode-hardlink.t b/test/blackbox-tests/test-cases/dune-cache/mode-hardlink.t index 1b902ed9775..ae152ca4860 100644 --- a/test/blackbox-tests/test-cases/dune-cache/mode-hardlink.t +++ b/test/blackbox-tests/test-cases/dune-cache/mode-hardlink.t @@ -35,9 +35,9 @@ never built [target1] before. $ dune build --config-file=config target1 --debug-cache=shared,workspace-local \ > 2>&1 | grep '_build/default/source\|_build/default/target' Workspace-local cache miss: _build/default/source: never seen this target before - Shared cache miss [3ad1761950da90e34e52b4c065db1504] (_build/default/source): not found in cache + Shared cache miss [761de13745c580498ceed897e6f7dfa0] (_build/default/source): not found in cache Workspace-local cache miss: _build/default/target1: never seen this target before - Shared cache miss [b5096eeda3d7be4e9a631c563907399e] (_build/default/target1): not found in cache + Shared cache miss [bca67363790f3659e7dbb055563002ce] (_build/default/target1): not found in cache $ dune_cmd stat hardlinks _build/default/source 3 diff --git a/test/blackbox-tests/test-cases/dune-cache/repro-check.t b/test/blackbox-tests/test-cases/dune-cache/repro-check.t index 0fe0906bf2f..7be49c92a65 100644 --- a/test/blackbox-tests/test-cases/dune-cache/repro-check.t +++ b/test/blackbox-tests/test-cases/dune-cache/repro-check.t @@ -67,7 +67,7 @@ Set 'cache-check-probability' to 1.0, which should trigger the check > EOF $ rm -rf _build $ dune build --config-file config reproducible non-reproducible - Warning: cache store error [e4096cb8e17c59cb28c421878c60fbfa]: ((in_cache + Warning: cache store error [a6a24f394ece470e01ae5a1642dfeaff]: ((in_cache ((non-reproducible 1c8fc4744d4cef1bd2b8f5e915b36be9))) (computed ((non-reproducible 6cfaa7a90747882bcf4ffe7252c1cf89)))) after executing (echo 'build non-reproducible';cp dep non-reproducible) @@ -119,7 +119,7 @@ Test that the environment variable and the command line flag work too $ rm -rf _build $ DUNE_CACHE_CHECK_PROBABILITY=1.0 dune build --cache=enabled reproducible non-reproducible - Warning: cache store error [e4096cb8e17c59cb28c421878c60fbfa]: ((in_cache + Warning: cache store error [a6a24f394ece470e01ae5a1642dfeaff]: ((in_cache ((non-reproducible 1c8fc4744d4cef1bd2b8f5e915b36be9))) (computed ((non-reproducible 6cfaa7a90747882bcf4ffe7252c1cf89)))) after executing (echo 'build non-reproducible';cp dep non-reproducible) @@ -131,7 +131,7 @@ Test that the environment variable and the command line flag work too $ rm -rf _build $ dune build --cache=enabled --cache-check-probability=1.0 reproducible non-reproducible - Warning: cache store error [e4096cb8e17c59cb28c421878c60fbfa]: ((in_cache + Warning: cache store error [a6a24f394ece470e01ae5a1642dfeaff]: ((in_cache ((non-reproducible 1c8fc4744d4cef1bd2b8f5e915b36be9))) (computed ((non-reproducible 6cfaa7a90747882bcf4ffe7252c1cf89)))) after executing (echo 'build non-reproducible';cp dep non-reproducible) diff --git a/test/blackbox-tests/test-cases/dune-cache/trim.t b/test/blackbox-tests/test-cases/dune-cache/trim.t index dcda72696dc..3e708ad2a75 100644 --- a/test/blackbox-tests/test-cases/dune-cache/trim.t +++ b/test/blackbox-tests/test-cases/dune-cache/trim.t @@ -78,8 +78,8 @@ entries uniformly. $ (cd "$PWD/.xdg-cache/dune/db/meta/v5"; grep -rws . -e 'metadata' | sort ) > out $ cat out - ./c2/c2ad4d4223dc4899614b496fe575ab08:((8:metadata)(5:files(8:target_b32:8a53bfae3829b48866079fa7f2d97781))) - ./d9/d9253f5d1695e3bee65f4e6e63b4dc5e:((8:metadata)(5:files(8:target_a32:5637dd9730e430c7477f52d46de3909c))) + ./1e/1efc41b0afe3809e04a72bc8adc62354:((8:metadata)(5:files(8:target_a32:5637dd9730e430c7477f52d46de3909c))) + ./32/328a92f21e553977cbd543f462bcac6c:((8:metadata)(5:files(8:target_b32:8a53bfae3829b48866079fa7f2d97781))) $ digest="$(awk -F: '/target_b/ { digest=$1 } END { print digest }' < out)" diff --git a/test/expect-tests/dune_engine/action_to_sh_tests.ml b/test/expect-tests/dune_engine/action_to_sh_tests.ml index e8cec0f6a01..16e86862651 100644 --- a/test/expect-tests/dune_engine/action_to_sh_tests.ml +++ b/test/expect-tests/dune_engine/action_to_sh_tests.ml @@ -177,12 +177,6 @@ let%expect_test "copy" = cp foo bar |}] ;; -let%expect_test "system" = - System "foo bar baz" |> print; - [%expect {| - foo bar baz |}] -;; - let%expect_test "bash" = Bash "echo Hello world" |> print; [%expect {|