From b9c4dd233962a89d9aaf3bc968373edebfd80269 Mon Sep 17 00:00:00 2001
From: Jeremie Dimino <jdimino@janestreet.com>
Date: Mon, 29 Jan 2018 11:26:11 +0000
Subject: [PATCH] Remove files from the digest cache when promoting them.

This is to avoid problems with incremental compilation on OSX.

Fix #456
---
 CHANGES.md                                   |  3 +++
 bin/main.ml                                  |  6 +++++-
 src/action.ml                                | 19 +++++++++++++++++++
 src/build_system.ml                          | 10 ++++++----
 src/utils.ml                                 |  5 +----
 test/blackbox-tests/test-cases/promote/run.t |  7 +++++--
 6 files changed, 39 insertions(+), 11 deletions(-)

diff --git a/CHANGES.md b/CHANGES.md
index 49267deb..8a8fe09f 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -87,6 +87,9 @@
 - Always build `boot.exe` as a bytecode program. It makes the build of
   jbuilder faster and fix the build on some architectures (#463, fixes #446)
 
+- Fix bad interaction between promotion and incremental builds on OSX
+  (#460, fix #456)
+
 1.0+beta16 (05/11/2017)
 -----------------------
 
diff --git a/bin/main.ml b/bin/main.ml
index 3e5ef995..cadb785a 100644
--- a/bin/main.ml
+++ b/bin/main.ml
@@ -1148,7 +1148,11 @@ let promote =
     ] in
   let go common =
     set_common common ~targets:[];
-    Action.Promotion.promote_files_registered_in_last_run ()
+    (* We load and restore the digest cache as we need to clear the
+       cache for promoted files, due to issues on OSX. *)
+    Utils.Cached_digest.load ();
+    Action.Promotion.promote_files_registered_in_last_run ();
+    Utils.Cached_digest.dump ()
   in
   ( Term.(const go
           $ common)
diff --git a/src/action.ml b/src/action.ml
index 82b680ec..94b94fb4 100644
--- a/src/action.ml
+++ b/src/action.ml
@@ -630,10 +630,29 @@ module Promotion = struct
 
   let do_promote db =
     let by_targets = group_by_targets db  in
+    let potential_build_contexts =
+      match Path.readdir Path.build_dir with
+      | exception _ -> []
+      | files ->
+        List.filter_map files ~f:(fun fn ->
+          if fn = "" || fn.[0] = '.' || fn = "install" then
+            None
+          else
+            let path = Path.(relative build_dir) fn in
+            Option.some_if (Path.is_directory path) path)
+    in
+    let dirs_to_clear_from_cache = Path.root :: potential_build_contexts in
     Path.Map.iter by_targets ~f:(fun ~key:dst ~data:srcs ->
       match srcs with
       | [] -> assert false
       | src :: others ->
+        (* We remove the files from the digest cache to force a rehash
+           on the next run. We do this because on OSX [mtime] is not
+           precise enough and if a file is modified and promoted
+           quickly, it will look like it hasn't changed even though it
+           might have. *)
+        List.iter dirs_to_clear_from_cache ~f:(fun dir ->
+          Utils.Cached_digest.remove (Path.append dir dst));
         File.promote { src; dst };
         List.iter others ~f:(fun path ->
           Format.eprintf " -> ignored %s.@."
diff --git a/src/build_system.ml b/src/build_system.ml
index e41d1c7c..c9d125c2 100644
--- a/src/build_system.ml
+++ b/src/build_system.ml
@@ -1056,7 +1056,6 @@ module Trace = struct
   let file = "_build/.db"
 
   let dump (trace : t) =
-    Utils.Cached_digest.dump ();
     let sexp =
       Sexp.List (
         Hashtbl.fold trace ~init:Pmap.empty ~f:(fun ~key ~data acc ->
@@ -1069,7 +1068,6 @@ module Trace = struct
       Io.write_file file (Sexp.to_string sexp)
 
   let load () =
-    Utils.Cached_digest.load ();
     let trace = Hashtbl.create 1024 in
     if Sys.file_exists file then begin
       let sexp = Sexp.load ~fname:file ~mode:Single in
@@ -1090,11 +1088,15 @@ let all_targets t =
   Hashtbl.fold t.files ~init:[] ~f:(fun ~key ~data:_ acc -> key :: acc)
 
 let finalize t =
+  (* Promotion must be handled before dumping the digest cache, as it might delete some
+     entries. *)
+  Action.Promotion.finalize ();
   Promoted_to_delete.dump ();
-  Trace.dump t.trace;
-  Action.Promotion.finalize ()
+  Utils.Cached_digest.dump ();
+  Trace.dump t.trace
 
 let create ~contexts ~file_tree =
+  Utils.Cached_digest.load ();
   let contexts =
     List.map contexts ~f:(fun c -> (c.Context.name, c))
     |> String_map.of_alist_exn
diff --git a/src/utils.ml b/src/utils.ml
index 5bad2601..02622f65 100644
--- a/src/utils.ml
+++ b/src/utils.ml
@@ -196,10 +196,7 @@ module Cached_digest = struct
               };
       digest
 
-  let remove fn =
-    match Hashtbl.find cache fn with
-    | None -> ()
-    | Some file -> file.timestamp_checked <- false
+  let remove fn = Hashtbl.remove cache fn
 
   let db_file = "_build/.digest-db"
 
diff --git a/test/blackbox-tests/test-cases/promote/run.t b/test/blackbox-tests/test-cases/promote/run.t
index 7c67b02f..07d7bd08 100644
--- a/test/blackbox-tests/test-cases/promote/run.t
+++ b/test/blackbox-tests/test-cases/promote/run.t
@@ -1,4 +1,4 @@
-  $ echo titi > x
+  $ printf titi > x
 
   $ $JBUILDER build --root . -j1 --diff-command false @blah 2>&1 | sed 's/.*false.*/DIFF/'
             sh (internal) (exit 1)
@@ -15,7 +15,10 @@
   $ cat x
   toto
 
-  $ echo titi > x
+Otherwise this test fails on OSX
+  $ jbuilder clean --root . -j1
+
+  $ printf titi > x
   $ $JBUILDER build --root . -j1 --diff-command false @blah --auto-promote 2>&1 | sed 's/.*false.*/DIFF/'
             sh (internal) (exit 1)
   DIFF