Merge pull request #760 from diml/fix-759

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
-      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 ->
-          Path.rm_rf sandbox_dir;
-          let sandboxed path =
-            if Path.is_local path then
-              Path.append sandbox_dir path
-            else
-              path
-          in
-          make_local_parent_dirs t all_deps ~map_path:sandboxed;
-          make_local_parent_dirs t targets  ~map_path:sandboxed;
-          Action.sandbox action
-            ~sandboxed
-            ~deps:all_deps_as_list
-            ~targets:targets_as_list
-        | None ->
-          action
-      in
-      make_local_dirs t (Action.chdirs action);
-      with_locks locks ~f:(fun () ->
-        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;
-      clear_targets_digests_after_rule_execution targets_as_list;
-      (match mode with
-       | Standard | Fallback | Not_a_rule_stanza | Ignore_source_files -> ()
-       | Promote | Promote_but_delete_on_clean ->
-         Pset.iter targets ~f:(fun path ->
-           let in_source_tree = Option.value_exn (Path.drop_build_context path) in
-           if mode = Promote_but_delete_on_clean then
-             Promoted_to_delete.add in_source_tree;
-           Io.copy_file ~src:path ~dst:in_source_tree));
-      t.hook Rule_completed
-    end else begin
-      t.hook Rule_completed;
-      Fiber.return ()
-    end
+    begin
+      if deps_or_rule_changed || targets_missing || force then begin
+        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 ->
+            Path.rm_rf sandbox_dir;
+            let sandboxed path =
+              if Path.is_local path then
+                Path.append sandbox_dir path
+              else
+                path
+            in
+            make_local_parent_dirs t all_deps ~map_path:sandboxed;
+            make_local_parent_dirs t targets  ~map_path:sandboxed;
+            Action.sandbox action
+              ~sandboxed
+              ~deps:all_deps_as_list
+              ~targets:targets_as_list
+          | None ->
+            action
+        in
+        make_local_dirs t (Action.chdirs action);
+        with_locks locks ~f:(fun () ->
+          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;
+        clear_targets_digests_after_rule_execution targets_as_list
+      end else
+        Fiber.return ()
+    end >>| fun () ->
+    begin
+      match mode with
+      | Standard | Fallback | Not_a_rule_stanza | Ignore_source_files -> ()
+      | Promote | Promote_but_delete_on_clean ->
+        Pset.iter targets ~f:(fun path ->
+          let in_source_tree = Option.value_exn (Path.drop_build_context path) in
+          if not (Path.exists in_source_tree) ||
+             (Utils.Cached_digest.file path <>
+              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/dune.inc

@@ -193,6 +193,14 @@
      (run ${exe:cram.exe} -skip-versions 4.02.3 -test run.t)
      (diff? run.t run.t.corrected))))))
 
+(alias
+ ((name github759)
+  (deps ((package dune) (files_recursively_in test-cases/github759)))
+  (action
+   (chdir
+    test-cases/github759
+    (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))))
+
 (alias
  ((name include-loop)
   (deps ((package dune) (files_recursively_in test-cases/include-loop)))
@@ -476,6 +484,7 @@
     (alias github644)
     (alias github660)
     (alias github717-odoc-index)
+    (alias github759)
     (alias include-loop)
     (alias inline_tests)
     (alias installable-dup-private-libs)
@@ -528,6 +537,7 @@
     (alias github568)
     (alias github597)
     (alias github660)
+    (alias github759)
     (alias include-loop)
     (alias inline_tests)
     (alias installable-dup-private-libs)

test/blackbox-tests/test-cases/github759/jbuild

@@ -0,0 +1 @@
+(library ((name foo)))

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

@@ -0,0 +1,17 @@
+  $ jbuilder build foo.cma
+  $ cat .merlin
+  B _build/default/.foo.objs
+  FLG -open Foo -w -40
+  S .
+  $ rm -f .merlin
+  $ jbuilder build foo.cma
+  $ cat .merlin
+  B _build/default/.foo.objs
+  FLG -open Foo -w -40
+  S .
+  $ echo toto > .merlin
+  $ jbuilder build foo.cma
+  $ cat .merlin
+  B _build/default/.foo.objs
+  FLG -open Foo -w -40
+  S .