Diff action diffs with the empty file when the file doesn't exists

Signed-off-by: François Bobot <[email protected]>

doc/concepts.rst

@@ -943,6 +943,8 @@ However, it is different for the following reason:
   produce ``b``. For cases where commands optionally produce a
   *corrected* file
 
+- if ``<file1>`` doesn't exists it will compare with the empty file
+
 - it allows promotion. See below
 
 Note that ``(cmp a b)`` does no end-of-line normalization and doesn't

src/dune_engine/action_exec.ml

@@ -319,8 +319,10 @@ let rec exec t ~ectx ~eenv =
           ~finally:(fun () ->
             ( match optional with
             | false ->
+              (* Promote if in the source tree or not a target. The second case
+                 means that the diffing have been done with the empty file *)
               if
-                is_copied_from_source_tree file1
+                (is_copied_from_source_tree file1 || not (Path.exists file1))
                 && not (is_copied_from_source_tree (Path.build file2))
               then
                 Promotion.File.register_dep
@@ -330,7 +332,8 @@ let rec exec t ~ectx ~eenv =
                           (Path.extract_build_context_dir_maybe_sandboxed file1)))
                   ~correction_file:file2
             | true ->
-              if is_copied_from_source_tree file1 then
+              if is_copied_from_source_tree file1 || not (Path.exists file1)
+              then
                 Promotion.File.register_intermediate
                   ~source_file:
                     (snd

src/dune_engine/build.ml

@@ -10,6 +10,7 @@ type 'a t =
   | Paths_for_rule : Path.Set.t -> unit t
   | Paths_glob : File_selector.t -> Path.Set.t t
   | If_file_exists : Path.t * 'a t * 'a t -> 'a t
+  | Filter_existing_files : ('a * Path.Set.t) t -> ('a * Path.Set.t) t
   | Contents : Path.t -> string t
   | Lines_of : Path.t -> string list t
   | Dyn_paths : ('a * Path.Set.t) t -> 'a t
@@ -138,6 +139,8 @@ let if_file_exists p ~then_ ~else_ = If_file_exists (p, then_, else_)
 
 let file_exists p = if_file_exists p ~then_:(return true) ~else_:(return false)
 
+let filter_existing_files p = Filter_existing_files p
+
 let paths_existing paths =
   all_unit
     (List.map paths ~f:(fun file ->
@@ -296,6 +299,7 @@ end = struct
         static_deps then_
       else
         static_deps else_
+    | Filter_existing_files p -> static_deps p
     | Dyn_paths t -> static_deps t
     | Dyn_deps t -> static_deps t
     | Contents p ->
@@ -336,6 +340,7 @@ let fold_labeled (type acc) t ~(init : acc) ~f =
         loop then_ acc
       else
         loop else_ acc
+    | Filter_existing_files p -> loop p acc
     | Memo m -> loop m.t acc
     | Catch (t, _) -> loop t acc
   in
@@ -394,6 +399,10 @@ end = struct
           go then_
         else
           go else_
+      | Filter_existing_files p ->
+        let (x, files), dyn_deps = go p in
+        let files = Path.Set.filter ~f:file_exists files in
+        ((x, files), dyn_deps)
       | Catch (t, on_error) -> (
         try go t with exn -> (on_error exn, Dep.Set.empty) )
       | Memo m -> Memo.eval m

src/dune_engine/build.mli

@@ -158,13 +158,17 @@ val strings : Path.t -> string list t
 val read_sexp : Path.t -> Dune_lang.Ast.t t
 
 (** Evaluates to [true] if the file is present on the file system or is the
-    target of a rule. *)
+    target of a rule. It doesn't add the path as dependency *)
 val file_exists : Path.t -> bool t
 
 (** [if_file_exists p ~then ~else] is a description that behaves like [then_] if
     [file_exists p] evaluates to [true], and [else_] otherwise. *)
 val if_file_exists : Path.t -> then_:'a t -> else_:'a t -> 'a t
 
+(** [filter_existing_files p] is a build description which keep only the
+    existing files *)
+val filter_existing_files : ('a * Path.Set.t) t -> ('a * Path.Set.t) t
+
 (** Always fail when executed. We pass a function rather than an exception to
     get a proper backtrace *)
 val fail : fail -> _ t

src/dune_engine/diff.ml

@@ -31,6 +31,12 @@ let decode_binary path target =
   { optional = false; file1; file2; mode = Binary }
 
 let eq_files { optional; mode; file1; file2 } =
+  let file1 =
+    if Path.exists file1 then
+      file1
+    else
+      Config.dev_null
+  in
   let file2 = Path.build file2 in
   (optional && not (Path.exists file2))
   || Mode.compare_files mode file1 file2 = Eq

src/dune_rules/action_unexpanded.ml

@@ -327,6 +327,7 @@ module Infer : sig
   module Outcome : sig
     type t =
       { deps : Path.Set.t
+      ; deps_if_exist : Path.Set.t
       ; targets : Path.Build.Set.t
       }
   end
@@ -340,6 +341,7 @@ end = struct
   module Outcome = struct
     type t =
       { deps : Path.Set.t
+      ; deps_if_exist : Path.Set.t
       ; targets : Path.Build.Set.t
       }
   end
@@ -369,6 +371,7 @@ end = struct
 
     type t =
       { deps : path_set
+      ; deps_if_exist : path_set
       ; targets : target_set
       }
   end
@@ -386,11 +389,16 @@ end = struct
 
     val ( +< ) : outcome -> path -> outcome
 
+    (** Add a dependency *)
     val ( +<+ ) : outcome -> target -> outcome
 
     val ( +<! ) : outcome -> program -> outcome
 
+    (** Remove a target *)
     val ( +<- ) : outcome -> target -> outcome
+
+    (** Add an optional (if exists) dependency *)
+    val ( +<? ) : outcome -> path -> outcome
   end
 
   module Make
@@ -434,9 +442,9 @@ end = struct
       | Cram script -> acc +< script
       | Diff { optional; file1; file2; mode = _ } ->
         if optional then
-          acc +< file1 +<- file2
+          acc +<? file1 +<- file2
         else
-          acc +< file1 +<+ file2
+          acc +<? file1 +<+ file2
       | Merge_files_into (sources, _extras, target) ->
         List.fold_left sources ~init:acc ~f:( +< ) +@+ target
       | Echo _
@@ -449,14 +457,22 @@ end = struct
       | Format_dune_file (src, dst) -> acc +< src +@+ dst
 
     let infer t =
-      let { deps; targets } =
-        infer { deps = Sets.Deps.empty; targets = Sets.Targets.empty } t
+      let { deps; deps_if_exist; targets } =
+        infer
+          { deps = Sets.Deps.empty
+          ; deps_if_exist = Sets.Deps.empty
+          ; targets = Sets.Targets.empty
+          }
+          t
       in
 
       (* A file can be inferred as both a dependency and a target, for instance:
 
          {[ (progn (copy a b) (copy b c)) ]} *)
-      { deps = Sets.Deps.diff deps targets; targets }
+      { deps = Sets.Deps.diff deps targets
+      ; deps_if_exist = Sets.Deps.diff deps_if_exist targets
+      ; targets
+      }
   end
   [@@inline always]
 
@@ -482,6 +498,9 @@ end = struct
               let ( +<+ ) acc fn =
                 { acc with deps = Path.Set.add acc.deps (Path.build fn) }
 
+              let ( +<? ) acc fn =
+                { acc with deps_if_exist = Path.Set.add acc.deps_if_exist fn }
+
               let ( +<- ) acc fn =
                 { acc with targets = Path.Build.Set.remove acc.targets fn }
 
@@ -513,6 +532,12 @@ end = struct
             { acc with deps = Path.Set.add acc.deps (Path.build fn) }
           | Unexpanded _ -> acc
 
+        let ( +<? ) acc (fn : _ String_with_vars.Partial.t) =
+          match fn with
+          | Expanded fn ->
+            { acc with deps_if_exist = Path.Set.add acc.deps_if_exist fn }
+          | Unexpanded _ -> acc
+
         let ( +<- ) acc (fn : _ String_with_vars.Partial.t) =
           match fn with
           | Expanded fn ->
@@ -547,6 +572,12 @@ end = struct
             { acc with deps = Path.Set.add acc.deps (Path.build fn) }
           | Unexpanded _ -> acc
 
+        let ( +<? ) acc (fn : _ String_with_vars.Partial.t) =
+          match fn with
+          | Expanded fn ->
+            { acc with deps_if_exist = Path.Set.add acc.deps_if_exist fn }
+          | Unexpanded _ -> acc
+
         let ( +<- ) acc (fn : _ String_with_vars.Partial.t) =
           match fn with
           | Expanded fn ->
@@ -595,6 +626,7 @@ end = struct
   module Outcome_unexp = struct
     type t =
       { deps : S_unexp.Deps.t
+      ; deps_if_exist : S_unexp.Deps.t
       ; targets : S_unexp.Targets.t
       }
   end
@@ -614,6 +646,8 @@ end = struct
 
         let ( +<+ ) acc _ = acc
 
+        let ( +<? ) acc _ = acc
+
         let ( +<! ) = ( +< )
 
         let ( +<- ) acc fn =
@@ -626,6 +660,20 @@ end = struct
   let unexpanded_targets t = (Unexp.infer t).targets
 end
 
+let add_deps_if_exist deps_if_exist =
+  let open Build.O in
+  (let+ l =
+     Path.Set.to_list deps_if_exist
+     |> List.map
+          ~f:
+            Build.(
+              fun f ->
+                if_file_exists f ~then_:(return (Some f)) ~else_:(return None))
+     |> Build.all
+   in
+   List.filter_opt l)
+  |> Build.dyn_paths_unit
+
 let expand t ~loc ~dep_kind ~targets_dir ~targets:targets_written_by_user
     ~expander deps_written_by_user =
   let open Build.O in
@@ -645,7 +693,7 @@ let expand t ~loc ~dep_kind ~targets_dir ~targets:targets_written_by_user
       ~partial:(fun expander -> partial_expand t ~expander)
       ~final:(fun expander t -> Partial.expand t ~expander)
   in
-  let { Infer.Outcome.deps; targets } =
+  let { Infer.Outcome.deps; deps_if_exist; targets } =
     Infer.partial targets_written_by_user partially_expanded
   in
   Path.Build.Set.iter targets ~f:(fun target ->
@@ -659,22 +707,33 @@ let expand t ~loc ~dep_kind ~targets_dir ~targets:targets_written_by_user
           ]);
   let targets = Path.Build.Set.to_list targets in
   Build.path_set deps
+  >>> add_deps_if_exist deps_if_exist
   >>> Build.dyn_path_set
-        (let+ action =
-           let+ unresolved = fully_expanded in
-           let artifacts = Expander.artifacts expander in
-           Action.Unresolved.resolve unresolved ~f:(fun loc prog ->
-               Artifacts.Bin.binary artifacts ~loc prog |> Action.Prog.ok_exn)
+        (let+ (action, deps), deps_if_exist_which_exist =
+           Build.filter_existing_files
+             (let+ action =
+                let+ unresolved = fully_expanded in
+                let artifacts = Expander.artifacts expander in
+                Action.Unresolved.resolve unresolved ~f:(fun loc prog ->
+                    Artifacts.Bin.binary artifacts ~loc prog
+                    |> Action.Prog.ok_exn)
+              in
+
+              (* Targets cannot be introduced at this stage because they must
+                 all be expanded after partial expansion.
+
+                 This is because we don't allow things like: [(with-stdout-to
+                 %{read:foo} ..)] *)
+              let { Infer.Outcome.deps
+                  ; Infer.Outcome.deps_if_exist
+                  ; targets = _
+                  } =
+                Infer.infer action
+              in
+              let dir = Path.build (Expander.dir expander) in
+              ((Action.Chdir (dir, action), deps), deps_if_exist))
          in
-
-         (* Targets cannot be introduced at this stage because they must all be
-            expanded after partial expansion.
-
-            This is because we don't allow things like: [(with-stdout-to
-            %{read:foo} ..)] *)
-         let { Infer.Outcome.deps; targets = _ } = Infer.infer action in
-         let dir = Path.build (Expander.dir expander) in
-         (Action.Chdir (dir, action), deps))
+         (action, Path.Set.union deps deps_if_exist_which_exist))
   |> Build.with_targets ~targets
 
 (* We re-export [Action_dune_lang] in the end to avoid polluting the inferred

src/dune_rules/action_unexpanded.mli

@@ -41,6 +41,7 @@ module Infer : sig
   module Outcome : sig
     type t = private
       { deps : Path.Set.t
+      ; deps_if_exist : Path.Set.t
       ; targets : Path.Build.Set.t
       }
   end

test/blackbox-tests/test-cases/promote.t/dune

@@ -4,6 +4,10 @@
  (name blah)
  (action (diff x x.gen)))
 
+(alias
+ (name blah-non-existent)
+ (action (diff x-non-existent x.gen)))
+
 (rule (with-stdout-to x.gen.copy (cat x.gen)))
 
 (rule (with-stdout-to y.gen (echo "titi")))

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

@@ -3,17 +3,22 @@ General tests
 
   $ printf titi > x
 
-  $ dune build @blah
+  $ dune build @blah @blah-non-existent
   File "x", line 1, characters 0-0:
   Error: Files _build/default/x and _build/default/x.gen differ.
+  File "x-non-existent", line 1, characters 0-0:
+  Error: Files _build/default/x-non-existent and _build/default/x.gen differ.
   [1]
   $ cat x
   titi
 
   $ dune promote
   Promoting _build/default/x.gen to x.
+  Promoting _build/default/x.gen to x-non-existent.
   $ cat x
   toto
+  $ cat x-non-existent
+  toto
 
   $ dune build @blah
   $ cat x