Merge pull request #460 from ocaml/fix-promote-tests-on-osx

Fix bad interaction between promotion and incremental builds on OSX

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)
 -----------------------
 

bin/main.ml

@@ -1152,7 +1152,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)

src/action.ml

@@ -543,17 +543,6 @@ let fold_one_step t ~init:acc ~f =
 
 include Make_mapper(Ast)(Ast)
 
-let updated_files =
-  let rec loop acc t =
-    let acc =
-      match t with
-      | Write_file (fn, _) -> Path.Set.add fn acc
-      | _ -> acc
-    in
-    fold_one_step t ~init:acc ~f:loop
-  in
-  fun t -> loop Path.Set.empty t
-
 let chdirs =
   let rec loop acc t =
     let acc =
@@ -630,10 +619,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.@."

src/action.mli

@@ -44,9 +44,6 @@ include Action_intf.Helpers
 val t : t Sexp.Of_sexp.t
 val sexp_of_t : t Sexp.To_sexp.t
 
-(** Return the list of files under an [Update_file] *)
-val updated_files : t -> Path.Set.t
-
 (** Return the list of directories the action chdirs to *)
 val chdirs : t -> Path.Set.t
 

src/build_system.ml

@@ -672,13 +672,8 @@ let rec compile_rule t ?(copy_source=false) pre_rule =
       List.exists targets_as_list ~f:Path.is_alias_stamp_file
     in
     if deps_or_rule_changed || targets_missing || force then (
-      (* Do not remove files that are just updated, otherwise this would break incremental
-         compilation *)
-      let targets_to_remove =
-        Pset.diff targets (Action.updated_files action)
-      in
-      Pset.iter targets_to_remove ~f:Path.unlink_no_err;
-      pending_targets := Pset.union targets_to_remove !pending_targets;
+      List.iter targets_as_list ~f:Path.unlink_no_err;
+      pending_targets := Pset.union targets !pending_targets;
       let action =
         match sandbox_dir with
         | Some sandbox_dir ->
@@ -703,7 +698,7 @@ let rec compile_rule t ?(copy_source=false) pre_rule =
         Action.exec ?context ~targets action) >>| fun () ->
       Option.iter sandbox_dir ~f:Path.rm_rf;
       (* All went well, these targets are no longer pending *)
-      pending_targets := Pset.diff !pending_targets targets_to_remove;
+      pending_targets := Pset.diff !pending_targets targets;
       clear_targets_digests_after_rule_execution targets_as_list;
       match mode with
       | Standard | Fallback | Not_a_rule_stanza | Ignore_source_files -> ()
@@ -1056,7 +1051,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 +1063,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 +1083,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

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"
 

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