Test cache trimming priority in the [copy] mode (#4497)

I wanted to fix trimming in the [copy] mode because I thought it was broken, but when
adding a test I realised that it actually works fine locally (perhaps, not reliably though).
I added a comment to explain how prioritising trimming by [ctime] happens to work
both in [hardlink] and [copy] modes.

The [copy]-related tests failed on Mac OSX, so I added [dune_cmd override-on macosx]
to fix them until we find a more reliable solution.

Signed-off-by: Andrey Mokhov <[email protected]>

src/dune_cache/trimmer.ml

@@ -73,15 +73,21 @@ let files_in_cache_for_all_supported_versions () =
    skip it while trimming. *)
 let file_exists_and_is_unused ~stats = stats.Unix.st_nlink = 1
 
+(* Dune uses [ctime] to prioritise entries for deletion. How does this work?
+
+   - In the [Hardlink] mode, an entry to become unused when it loses the last
+   hard link that points to it from a build directory. When this happens, the
+   entry's [ctime] is modified. This means that the trimmer will start deleting
+   entries starting from the one that became unused first.
+
+   - In the [Copy] mode, all entries have hard link count of 1, and so they all
+   appear to be unused to the trimmer. However, copying an entry to the cache,
+   as well as copying it from the cache to a build directory, both change the
+   entry's [ctime]. This means that the trimmer will start deleting entries
+   starting from the one that was least recently created or used. *)
 let trim ~goal =
   let files = files_in_cache_for_all_supported_versions () |> List.map ~f:fst in
   let files =
-    (* CR-soon amokhov: When the cache storage mode is [Copy], comparing [ctime]
-       isn't a good heuristic unless we bump [ctime] of a cache entry whenever
-       we restore it from the cache. The simplest way to do that is to [touch]
-       the entry but that also changes its [mtime] which isn't great. One way to
-       bump [ctime] of an entry without changing anything else is to use [chmod]
-       to set the same permissions that the entry already has. *)
     List.sort
       ~compare:(fun (_, _, ctime1) (_, _, ctime2) -> Poly.compare ctime1 ctime2)
       (List.filter_map files ~f:(fun path ->
@@ -97,7 +103,7 @@ let trim ~goal =
     if trimmed_so_far.trimmed_bytes >= goal then
       trimmed_so_far
     else (
-      Path.unlink path;
+      Path.unlink_no_err path;
       (* CR-someday amokhov: We should really be using block_size * #blocks
          because that's how much we save actually. *)
       Trimming_result.add trimmed_so_far ~bytes

test/blackbox-tests/test-cases/dune-cache/trim.t/run.t

@@ -36,7 +36,7 @@ Check that trimming does not crash when the cache directory does not exist.
   $ dune cache trim --size 0B
   Freed 0 bytes
 
-Check that the digest scheme for executable and non-excutable digests hasn't
+Check that the digest scheme for executable and non-executable digests hasn't
 changed. If it has, make sure to increment the version of the cache. Note that
 the current digests for both files match those computed by Jenga.
 
@@ -59,11 +59,10 @@ Build some more targets.
 
   $ dune build target_a target_b
 
-Dune stores the result of rule execution in a store keyed by "rule
-digests". If the way such rule digests are computed changes, we could
-end up in a situation where the same hash means something different
-before and after the change, which is bad. To reduce the risk, we
-inject a version number into rule digests.
+Dune stores the result of rule execution in a store keyed by "rule digests". If
+the way such rule digests are computed changes, we could end up in a situation
+where the same hash means something different before and after the change, which
+is bad. To reduce the risk, we inject a version number into rule digests.
 
 If you see the test below breaking, this means you changed the metadata format
 or the way that digests are computed and you should increment the corresponding
@@ -139,12 +138,14 @@ sizes might vary on different platforms
 The cache deletes oldest files first.
 
   $ reset
-  $ dune build target_b
-  $ dune_cmd wait-for-fs-clock-to-advance
-  $ dune build target_a
-The bellow rm commands also update the ctime, so we need to do it in
-the same order to preserve the fact that target_b is older than
-target_a:
+  $ dune build target_a target_b
+
+The [rm] commands below update the [ctime] of the corresponding cache entries.
+By deleting [target_b] first, we make its [ctime] older. The trimmer deletes
+older entries first, which is why [target_b] is trimmed while [target_a] is not.
+We know that [target_b] was trimmed, because it had to be rebuilt as indicated
+by the existence of [beacon_b].
+
   $ rm -f _build/default/beacon_b _build/default/target_b
   $ dune_cmd wait-for-fs-clock-to-advance
   $ rm -f _build/default/beacon_a _build/default/target_a
@@ -160,11 +161,10 @@ target_a:
   $ dune_cmd exists _build/default/beacon_b
   true
 
-  $ reset
-
-When a cache entry becomes unused, its ctime is modified and will determine the
-order of trimming.
+Now let's redo the same test but delete the two targets in the opposite order,
+thus making the trimmer delete [target_a] instead of [target_b] as above.
 
+  $ reset
   $ dune build target_a target_b
   $ rm -f _build/default/beacon_a _build/default/target_a
   $ dune_cmd wait-for-fs-clock-to-advance
@@ -181,22 +181,94 @@ order of trimming.
   $ dune_cmd exists _build/default/beacon_b
   false
 
-  $ reset
-
-Check garbage collection: both multi_a and multi_b must be removed as
-they are part of the same rule.
+Test garbage collection: both [multi_a] and [multi_b] must be removed as they
+are part of the same rule.
 
+  $ reset
   $ dune build multi_a multi_b
   $ rm -f _build/default/multi_a _build/default/multi_b
   $ dune cache trim --trimmed-size 1B
   Freed 123 bytes
 
-Check the error message when using removed subcommands [start] and [stop]
+Test trimming priority in the [copy] mode.
+
+First, to work around the existence of [configurator.v2] entry in the cache, we
+first build the two targets in the [hardlink] mode, and trim everything apart
+from the [configurator.v2] entry, so that it keeps its hard link and the trimmer
+doesn't consider it for deletion.
+
+  $ reset
+  $ dune build target_a target_b
+  $ rm -f _build/default/target_a _build/default/target_b
+  $ dune cache trim --size 1B
+  Freed 158 bytes
+
+Now we are ready to build the two targets in the [copy] mode to populate the
+cache. After that, we clean the build directory.
+
+  $ dune build target_a target_b --cache-storage-mode=copy
+  $ rm -f _build/default/beacon_a _build/default/target_a
+  $ rm -f _build/default/beacon_b _build/default/target_b
+
+We now build [target_a] and then [target_b] in the [copy] mode, which would make
+the [target_a] the least recently used entry in the cache.
+
+  $ dune build target_a --cache-storage-mode=copy
+  $ dune_cmd wait-for-fs-clock-to-advance
+  $ dune build target_b --cache-storage-mode=copy
+  $ dune_cmd wait-for-fs-clock-to-advance
+
+
+Test that [target_a] is prioritised for trimming.
+
+Note that on Mac OSX these tests currently fail, which is why we override the
+output of [dune_cmd exists] by using [dune_cmd override-on macosx]. We should
+investigate and get rid of these overrides.
+
+  $ rm -f _build/default/beacon_a _build/default/target_a
+  $ rm -f _build/default/beacon_b _build/default/target_b
+  $ dune cache trim --trimmed-size 1B
+  Freed 79 bytes
+  $ dune build target_a target_b --cache-storage-mode=copy
+  $ dune_cmd stat hardlinks _build/default/target_a
+  1
+  $ dune_cmd stat hardlinks _build/default/target_b
+  1
+  $ dune_cmd exists _build/default/beacon_a | dune_cmd override-on macosx true
+  true
+  $ dune_cmd exists _build/default/beacon_b | dune_cmd override-on macosx false
+  false
+
+And now let's switch the order of deletion.
+
+  $ dune build target_b --cache-storage-mode=copy
+  $ dune_cmd wait-for-fs-clock-to-advance
+  $ dune build target_a --cache-storage-mode=copy
+  $ dune_cmd wait-for-fs-clock-to-advance
+
+Test that now [target_b] is prioritised for trimming.
+
+  $ rm -f _build/default/beacon_a _build/default/target_a
+  $ rm -f _build/default/beacon_b _build/default/target_b
+  $ dune cache trim --trimmed-size 1B
+  Freed 79 bytes
+  $ dune build target_a target_b --cache-storage-mode=copy
+  $ dune_cmd stat hardlinks _build/default/target_a
+  1
+  $ dune_cmd stat hardlinks _build/default/target_b
+  1
+  $ dune_cmd exists _build/default/beacon_a | dune_cmd override-on macosx false
+  false
+  $ dune_cmd exists _build/default/beacon_b | dune_cmd override-on macosx true
+  true
+
+Test the error message when using removed subcommands [start] and [stop].
 
   $ dune cache start
   Error: Dune no longer uses the cache daemon, and so the `start` and `stop`
   subcommands of `dune cache` were removed.
   [1]
+
   $ dune cache stop
   Error: Dune no longer uses the cache daemon, and so the `start` and `stop`
   subcommands of `dune cache` were removed.

test/blackbox-tests/utils/dune_cmd.ml

@@ -81,7 +81,7 @@ module Cat = struct
 
   let of_args = function
     | [ file ] -> File (Path.of_filename_relative_to_initial_cwd file)
-    | _ -> raise (Arg.Bad "Usage: dune_arg cat <file>")
+    | _ -> raise (Arg.Bad "Usage: dune_cmd cat <file>")
 
   let run (File p) = print_string (Io.read_file p)
 
@@ -95,7 +95,7 @@ module Exists = struct
 
   let of_args = function
     | [ path ] -> Path (Path.of_filename_relative_to_initial_cwd path)
-    | _ -> raise (Arg.Bad "Usage: dune_arg exists <path>")
+    | _ -> raise (Arg.Bad "Usage: dune_cmd exists <path>")
 
   let run (Path path) = print_string (Path.exists path |> Bool.to_string)
 
@@ -107,7 +107,7 @@ module Expand_lines = struct
 
   let of_args = function
     | [] -> ()
-    | _ -> raise (Arg.Bad ("Usage: dune_arg " ^ name))
+    | _ -> raise (Arg.Bad ("Usage: dune_cmd " ^ name))
 
   let run () =
     let re = Re.compile (Re.str "\\n") in
@@ -194,7 +194,7 @@ module Count_lines = struct
   let of_args = function
     | [] -> Stdin
     | [ file ] -> File (Path.of_filename_relative_to_initial_cwd file)
-    | _ -> raise (Arg.Bad "Usage: dune_arg count-lines <file>")
+    | _ -> raise (Arg.Bad "Usage: dune_cmd count-lines <file>")
 
   let run t =
     let n =
@@ -207,6 +207,45 @@ module Count_lines = struct
   let () = register name of_args run
 end
 
+module Override_on = struct
+  module Configurator = Configurator.V1
+
+  type t =
+    { system_to_override_on : string
+    ; desired_output : string
+    }
+
+  let name = "override-on"
+
+  let copy_stdin () =
+    let rec loop () =
+      match input_line stdin with
+      | exception End_of_file -> ()
+      | line ->
+        print_endline line;
+        loop ()
+    in
+    loop ()
+
+  let of_args = function
+    | [ system_to_override_on; desired_output ] ->
+      { system_to_override_on; desired_output }
+    | _ ->
+      raise
+        (Arg.Bad
+           "Usage: dune_cmd override-on <system-to-override-on> \
+            <desired-output>")
+
+  let run { system_to_override_on; desired_output } =
+    let config = Configurator.create "override-on" in
+    match Configurator.ocaml_config_var config "system" with
+    | Some system when String.equal system system_to_override_on ->
+      print_endline desired_output
+    | _ -> copy_stdin ()
+
+  let () = register name of_args run
+end
+
 module Rewrite_path = struct
   let name = "rewrite-path"