From 9ff7eb33be79c5e978944c44e4442cc048755a8e Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 31 Dec 2025 17:43:15 +0000 Subject: [PATCH 1/2] dev Signed-off-by: Rudi Grinberg From a260cd3d4755cb94be8ad215d60ff4d03345977b Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 4 Feb 2026 19:38:18 +0000 Subject: [PATCH 2/2] feature: sandbox snapshot event Signed-off-by: Rudi Grinberg --- doc/changes/added/13541.md | 1 + src/dune_engine/sandbox.ml | 35 +++++++++++-------- src/dune_trace/dune_trace.mli | 7 ++-- src/dune_trace/event.ml | 19 ++++++---- test/blackbox-tests/dune.jq | 3 ++ .../sandbox/patch-back-source-tree.t | 16 +++++++++ .../test-cases/sandbox/sandbox-events.t | 3 +- 7 files changed, 60 insertions(+), 24 deletions(-) create mode 100644 doc/changes/added/13541.md diff --git a/doc/changes/added/13541.md b/doc/changes/added/13541.md new file mode 100644 index 00000000000..e6b273685b6 --- /dev/null +++ b/doc/changes/added/13541.md @@ -0,0 +1 @@ +- Add a trace event for snapshotting the asndbox (#13541, @rgrinberg) diff --git a/src/dune_engine/sandbox.ml b/src/dune_engine/sandbox.ml index b0875021442..c1f5386f9c1 100644 --- a/src/dune_engine/sandbox.ml +++ b/src/dune_engine/sandbox.ml @@ -147,19 +147,26 @@ let link_deps t ~mode ~deps = let snapshot t = let root = Path.build t.dir in - Fpath.traverse - ~dir:(Path.to_string root) - ~init:Path.Map.empty - ~on_dir:(fun ~dir fname acc -> - let path = Path.relative root (Filename.concat dir fname) in - Path.Map.add_exn acc path `Dir) - ~on_file:(fun ~dir fname acc -> - let p = Path.relative root (Filename.concat dir fname) in - let stats = Unix.stat (Path.to_string p) in - Path.Map.add_exn acc p (`File (Cached_digest.Reduced_stats.of_unix_stats stats))) - ~on_other:`Ignore - ~on_symlink:`Ignore - () + let start = Time.now () in + let snapshot = + Fpath.traverse + ~dir:(Path.to_string root) + ~init:Path.Map.empty + ~on_dir:(fun ~dir fname acc -> + let path = Path.relative root (Filename.concat dir fname) in + Path.Map.add_exn acc path `Dir) + ~on_file:(fun ~dir fname acc -> + let p = Path.relative root (Filename.concat dir fname) in + let stats = Unix.stat (Path.to_string p) in + Path.Map.add_exn acc p (`File (Cached_digest.Reduced_stats.of_unix_stats stats))) + ~on_other:`Ignore + ~on_symlink:`Ignore + () + in + let stop = Time.now () in + Dune_trace.emit ~buffered:true Sandbox (fun () -> + Dune_trace.Event.sandbox `Snapshot ~start ~stop ~queued:None t.loc ~dir:t.dir); + snapshot ;; let create ~mode ~rule_loc ~dirs ~deps ~rule_dir ~rule_digest = @@ -316,5 +323,5 @@ let destroy t = in Dune_trace.emit ~buffered:true Sandbox (fun () -> let queued = Time.diff start queue_start in - Dune_trace.Event.sandbox_destroy ~start ~stop ~queued t.loc ~dir:t.dir) + Dune_trace.Event.sandbox `Destroy ~start ~stop ~queued:(Some queued) t.loc ~dir:t.dir) ;; diff --git a/src/dune_trace/dune_trace.mli b/src/dune_trace/dune_trace.mli index 764d847fd48..6620cdbc27f 100644 --- a/src/dune_trace/dune_trace.mli +++ b/src/dune_trace/dune_trace.mli @@ -37,10 +37,11 @@ module Event : sig type t - val sandbox_destroy - : start:Time.t + val sandbox + : [ `Snapshot | `Destroy ] + -> start:Time.t -> stop:Time.t - -> queued:Time.Span.t + -> queued:Time.Span.t option -> Loc.t -> dir:Path.Build.t -> t diff --git a/src/dune_trace/event.ml b/src/dune_trace/event.ml index 1f8b0610a4d..f8f8fe89f45 100644 --- a/src/dune_trace/event.ml +++ b/src/dune_trace/event.ml @@ -746,13 +746,20 @@ let spawn_thread ~name = Event.instant ~args ~name:"spawn_thread" now Thread ;; -let sandbox_destroy ~start ~stop ~queued loc ~dir = +let sandbox name ~start ~stop ~queued loc ~dir = let args = - [ "queued", Arg.span queued - ; "loc", Arg.string (Loc.to_file_colon_line loc) - ; "dir", Arg.build_path dir - ] + [ "loc", Arg.string (Loc.to_file_colon_line loc); "dir", Arg.build_path dir ] + in + let args = + match queued with + | None -> args + | Some queued -> ("queued", Arg.span queued) :: args in let dur = Time.diff stop start in - Event.complete ~args ~name:"destroy" ~start ~dur Sandbox + let name = + match name with + | `Destroy -> "destroy" + | `Snapshot -> "snapshot" + in + Event.complete ~args ~name ~start ~dur Sandbox ;; diff --git a/test/blackbox-tests/dune.jq b/test/blackbox-tests/dune.jq index 110dc93544a..fc9ecbde12c 100644 --- a/test/blackbox-tests/dune.jq +++ b/test/blackbox-tests/dune.jq @@ -75,3 +75,6 @@ def fsUpdateWithPath($path): select(.name == "fs_update") | .args | select(.path == $path); + +def censorDigestDir: + .args.dir |= (if . then sub("[0-9a-f]{32}"; "$DIGEST") else . end); diff --git a/test/blackbox-tests/test-cases/sandbox/patch-back-source-tree.t b/test/blackbox-tests/test-cases/sandbox/patch-back-source-tree.t index e09cb9ffd23..f90c10d50eb 100644 --- a/test/blackbox-tests/test-cases/sandbox/patch-back-source-tree.t +++ b/test/blackbox-tests/test-cases/sandbox/patch-back-source-tree.t @@ -34,6 +34,22 @@ All modified dependencies are promoted $ echo blah > x $ dune build + + $ dune trace cat | jq ' + > include "dune"; + > select(.cat == "sandbox" and .name == "snapshot") + > | censorDigestDir + > | .args + > ' + { + "loc": "dune:1", + "dir": "_build/.sandbox/$DIGEST" + } + { + "loc": "dune:1", + "dir": "_build/.sandbox/$DIGEST" + } + $ dune promote x Promoting _build/default/x to x. $ cat x diff --git a/test/blackbox-tests/test-cases/sandbox/sandbox-events.t b/test/blackbox-tests/test-cases/sandbox/sandbox-events.t index 0f16134420f..d34d355c4fa 100644 --- a/test/blackbox-tests/test-cases/sandbox/sandbox-events.t +++ b/test/blackbox-tests/test-cases/sandbox/sandbox-events.t @@ -12,9 +12,10 @@ Demonstrate sandbox events: $ dune build @foo $ dune trace cat | jq ' + > include "dune"; > select(.cat == "sandbox") > | del(.ts,.dur, .args.queued) - > | .args.dir |= (if . then sub("[0-9a-f]{32}"; "$DIGEST") else . end) + > | censorDigestDir > ' { "cat": "sandbox",