Fix #759

CHANGES.md

@@ -31,6 +31,9 @@ next
 - Display a better error messages when writing `(inline_tests)` in an
   executable stanza (#748, @diml)
 
+- Restore promoted files when they are deleted or changed in the
+  source tree (#760, fix #759, @diml)
+
 1.0+beta20 (10/04/2018)
 -----------------------
 

src/build_system.ml

@@ -753,48 +753,54 @@ let rec compile_rule t ?(copy_source=false) pre_rule =
       !Clflags.force &&
       List.exists targets_as_list ~f:Path.is_alias_stamp_file
     in
-    if deps_or_rule_changed || targets_missing || force then begin
+    begin
-      List.iter targets_as_list ~f:Path.unlink_no_err;
+      if deps_or_rule_changed || targets_missing || force then begin
-      pending_targets := Pset.union targets !pending_targets;
+        List.iter targets_as_list ~f:Path.unlink_no_err;
-      let action =
+        pending_targets := Pset.union targets !pending_targets;
-        match sandbox_dir with
+        let action =
-        | Some sandbox_dir ->
+          match sandbox_dir with
-          Path.rm_rf sandbox_dir;
+          | Some sandbox_dir ->
-          let sandboxed path =
+            Path.rm_rf sandbox_dir;
-            if Path.is_local path then
+            let sandboxed path =
-              Path.append sandbox_dir path
+              if Path.is_local path then
-            else
+                Path.append sandbox_dir path
-              path
+              else
-          in
+                path
-          make_local_parent_dirs t all_deps ~map_path:sandboxed;
+            in
-          make_local_parent_dirs t targets  ~map_path:sandboxed;
+            make_local_parent_dirs t all_deps ~map_path:sandboxed;
-          Action.sandbox action
+            make_local_parent_dirs t targets  ~map_path:sandboxed;
-            ~sandboxed
+            Action.sandbox action
-            ~deps:all_deps_as_list
+              ~sandboxed
-            ~targets:targets_as_list
+              ~deps:all_deps_as_list
-        | None ->
+              ~targets:targets_as_list
-          action
+          | None ->
-      in
+            action
-      make_local_dirs t (Action.chdirs action);
+        in
-      with_locks locks ~f:(fun () ->
+        make_local_dirs t (Action.chdirs action);
-        Action.exec ~context ~targets action) >>| fun () ->
+        with_locks locks ~f:(fun () ->
-      Option.iter sandbox_dir ~f:Path.rm_rf;
+          Action.exec ~context ~targets action) >>| fun () ->
-      (* All went well, these targets are no longer pending *)
+        Option.iter sandbox_dir ~f:Path.rm_rf;
-      pending_targets := Pset.diff !pending_targets targets;
+        (* All went well, these targets are no longer pending *)
-      clear_targets_digests_after_rule_execution targets_as_list;
+        pending_targets := Pset.diff !pending_targets targets;
-      (match mode with
+        clear_targets_digests_after_rule_execution targets_as_list
-       | Standard | Fallback | Not_a_rule_stanza | Ignore_source_files -> ()
+      end else
-       | Promote | Promote_but_delete_on_clean ->
+        Fiber.return ()
-         Pset.iter targets ~f:(fun path ->
+    end >>| fun () ->
-           let in_source_tree = Option.value_exn (Path.drop_build_context path) in
+    begin
-           if mode = Promote_but_delete_on_clean then
+      match mode with
-             Promoted_to_delete.add in_source_tree;
+      | Standard | Fallback | Not_a_rule_stanza | Ignore_source_files -> ()
-           Io.copy_file ~src:path ~dst:in_source_tree));
+      | Promote | Promote_but_delete_on_clean ->
-      t.hook Rule_completed
+        Pset.iter targets ~f:(fun path ->
-    end else begin
+          let in_source_tree = Option.value_exn (Path.drop_build_context path) in
-      t.hook Rule_completed;
+          if not (Path.exists in_source_tree) ||
-      Fiber.return ()
+             (Utils.Cached_digest.file path <>
-    end
+              Utils.Cached_digest.file in_source_tree) then begin
+            if mode = Promote_but_delete_on_clean then
+              Promoted_to_delete.add in_source_tree;
+            Io.copy_file ~src:path ~dst:in_source_tree
+          end)
+    end;
+    t.hook Rule_completed
   in
   let rule =
     { Internal_rule.

test/blackbox-tests/test-cases/github759/run.t

@@ -6,9 +6,12 @@
   $ rm -f .merlin
   $ jbuilder build foo.cma
   $ cat .merlin
-  cat: .merlin: No such file or directory
+  B _build/default/.foo.objs
-  [1]
+  FLG -open Foo -w -40
+  S .
   $ echo toto > .merlin
   $ jbuilder build foo.cma
   $ cat .merlin
-  toto
+  B _build/default/.foo.objs
+  FLG -open Foo -w -40
+  S .