Replace promote actions by diff actions + promote command (#421)

* Remove (promote ...) and (promote-if ...) * Remove `--promote ...` * Add (diff ...) and (diff? ...) * Add `jbuilder promote` and `--auto-promote` * Fix #423
2018-01-18 11:32:20 +00:00 · 2018-01-18 11:32:20 +00:00 · b06aad431e
parent 9347d4a767
commit b06aad431e
25 changed files with 486 additions and 370 deletions
--- a/14
+++ b/14
@ -23,6 +23,11 @@ reinstall: uninstall reinstall
 test:
 	$(BIN) runtest --dev

+promote:
+	$(BIN) promote
+
+accept-corrections: promote
+
 all-supported-ocaml-versions:
 	$(BIN) build --dev @install @runtest --workspace jbuild-workspace.dev --root .

@ -34,13 +39,8 @@ doc:
 	cd doc && sphinx-build . _build

 update-jbuilds: $(BIN)
-	$(BIN) build --dev @jbuild --promote copy
-
-accept-corrections:
-	for i in `find . -name \*.corrected`; do \
-	  cp $$i $${i%.corrected}; \
-	done
+	$(BIN) build --dev @doc/runtest --auto-promote

 .DEFAULT_GOAL := default
 .PHONY: default install uninstall reinstall clean test doc
-.PHONY: accept-corrections
+.PHONY: promote accept-corrections
--- a/bin/main.ml
+++ b/bin/main.ml
@ -23,7 +23,7 @@ type common =
  ; capture_outputs  : bool
  ; x                : string option
  ; diff_command     : string option
-  ; promote_mode     : Clflags.Promote_mode.t
+  ; auto_promote     : bool
  ; (* Original arguments for the external-lib-deps hint *)
    orig_args        : string list
  }
@ -42,7 +42,7 @@ let set_common c ~targets =
    Sys.chdir c.root;
  Clflags.workspace_root := Sys.getcwd ();
  Clflags.diff_command := c.diff_command;
-  Clflags.promote_mode := c.promote_mode;
+  Clflags.auto_promote := c.auto_promote;
  Clflags.external_lib_deps_hint :=
    List.concat
      [ ["jbuilder"; "external-lib-deps"; "--missing"]
@ -161,7 +161,8 @@ let common =
        no_buffer
        workspace_file
        diff_command
-        (root, only_packages, promote_mode, orig)
+        auto_promote
+        (root, only_packages, orig)
        x
    =
    let root, to_cwd =
@ -188,7 +189,7 @@ let common =
    ; orig_args
    ; target_prefix = String.concat ~sep:"" (List.map to_cwd ~f:(sprintf "%s/"))
    ; diff_command
-    ; promote_mode
+    ; auto_promote
    ; only_packages =
        Option.map only_packages
          ~f:(fun s -> String_set.of_list (String.split s ~on:','))
@ -279,23 +280,12 @@ let common =
                    targets given on the command line. It is only intended
                    for scripts.|})
  in
-  let promote =
-    let mode =
-      Arg.(conv
-             (Arg.parser_of_kind_of_string ~kind:"promotion mode"
-                Clflags.Promote_mode.of_string,
-              fun ppf mode ->
-                Format.pp_print_string ppf
-                  (Clflags.Promote_mode.to_string mode)))
-    in
+  let auto_promote =
    Arg.(value
-         & opt (some mode) None
-         & info ["promote"] ~docs
-             ~doc:"How to interpret promote actions. $(b,copy) means to print
-                   a diff and copy the generated files to the source tree when
-                   they differ. $(b,copy) is the default. $(b,check) means to
-                   only print a diff without copying files. $(b,ignore) means
-                   to ignore promote action altogether.")
+         & flag
+         & info ["auto-promote"] ~docs
+             ~doc:"Automatically promote files. This is similar to running
+                   $(b,jbuilder promote) after the build.")
  in
  let for_release = "for-release-of-packages" in
  let frop =
@ -308,38 +298,32 @@ let common =
                    packages as well as getting reproducible builds.|})
  in
  let root_and_only_packages =
-    let merge root only_packages promote release =
+    let merge root only_packages release =
      let fail opt =
        `Error (true,
                sprintf
                  "Cannot use -p/--%s and %s simultaneously"
                  for_release opt)
      in
-      match release, root, only_packages, promote with
-      | Some _, Some _, _, _ -> fail "--root"
-      | Some _, _, Some _, _ -> fail "--only-packages"
-      | Some _, _, _, Some _ -> fail "--promote"
-      | Some pkgs, None, None, None ->
+      match release, root, only_packages with
+      | Some _, Some _, _ -> fail "--root"
+      | Some _, _, Some _ -> fail "--only-packages"
+      | Some pkgs, None, None ->
        `Ok (Some ".",
             Some pkgs,
-             Clflags.Promote_mode.Ignore,
             ["-p"; pkgs]
            )
-      | None, _, _, _ ->
+      | None, _, _ ->
        `Ok (root,
             only_packages,
-             Option.value promote ~default:Clflags.Promote_mode.Copy,
             List.concat
               [ dump_opt "--root" root
               ; dump_opt "--only-packages" only_packages
-               ; dump_opt "--promote"
-                   (Option.map promote ~f:Clflags.Promote_mode.to_string)
               ])
    in
    Term.(ret (const merge
               $ root
               $ only_packages
-               $ promote
               $ frop))
  in
  let x =
@ -364,6 +348,7 @@ let common =
        $ no_buffer
        $ workspace_file
        $ diff_command
+        $ auto_promote
        $ root_and_only_packages
        $ x
       )
@ -1088,6 +1073,28 @@ let utop =
          $ Arg.(value & pos_right 0 string [] (Arg.info [] ~docv:"ARGS")))
  , Term.info "utop" ~doc ~man )

+let promote =
+  let doc = "Promote files from the last run" in
+  let man =
+    [ `S "DESCRIPTION"
+    ; `P {|Considering all actions of the form $(b,(diff a b)) that failed
+           in the last run of jbuilder, $(b,jbuilder promote) does the following:
+
+           If $(b,a) is present in the source tree but $(b,b) isn't, $(b,b) is
+           copied over to $(b,a) in the source tree. The idea behind this is that
+           you might use $(b,(diff file.expected file.generated)) and then call
+           $(b,jbuilder promote) to promote the generated file.
+         |}
+    ; `Blocks help_secs
+    ] in
+  let go common =
+    set_common common ~targets:[];
+    Action.Promotion.promote_files_registered_in_last_run ()
+  in
+  ( Term.(const go
+          $ common)
+  , Term.info "promote" ~doc ~man )
+
 let all =
  [ installed_libraries
  ; external_lib_deps
@ -1100,6 +1107,7 @@ let all =
  ; subst
  ; rules
  ; utop
+  ; promote
  ]

 let default =
--- a/doc/jbuild
+++ b/doc/jbuild
@ -16,5 +16,5 @@
  (run bash ${path:update-jbuild.sh} ${bin:jbuilder})))

 (alias
- ((name jbuild)
-  (action (promote (jbuild.inc.gen as jbuild.inc)))))
+ ((name runtest)
+  (action (diff jbuild.inc jbuild.inc.gen))))
--- a/doc/jbuild.inc
+++ b/doc/jbuild.inc
@ -53,6 +53,15 @@
 ((section man)
  (files (jbuilder-installed-libraries.1))))

+(rule
+ ((targets (jbuilder-promote.1))
+  (action  (with-stdout-to ${@}
+            (run ${bin:jbuilder} promote --help=groff)))))
+
+(install
+ ((section man)
+  (files (jbuilder-promote.1))))
+
 (rule
 ((targets (jbuilder-rules.1))
  (action  (with-stdout-to ${@}
--- a/doc/jbuild.rst
+++ b/doc/jbuild.rst
@ -555,15 +555,15 @@ For instance:
    (rule (with-stdout-to jbuild.inc.gen (run ./gen-jbuild.exe)))

    (alias
-     ((name   jbuild)
-      (action (promote (jbuild.inc.gen as jbuild.inc)))))
+     ((name   runtest)
+      (action (diff jbuild.inc jbuild.inc.gen))))

 With this jbuild file, running jbuilder as follow will replace the
 ``jbuild.inc`` file in the source tree by the generated one:

 .. code:: shell

-    $ jbuilder build @jbuild
+    $ jbuilder build @runtest --auto-promote

 Common items
 ============
@ -1014,13 +1014,12 @@ The following constructions are available:
  and ``cmd`` on Windows
 - ``(bash <cmd>)`` to execute a command using ``/bin/bash``. This is obviously
  not very portable
- ``(promote <files-to-promote>)`` copy generated files to the source
-  tree. See `Promotion`_ for more details
- ``(promote-if <files-to-promote>)`` is the same as ``(promote
-  <files-to-promote>)`` except that a form ``(<a> as <b>)`` is ignored
-  when ``<a>`` doesn't exists. Additionally, ``<a>`` won't be copied
-  if ``<b>`` doesn't already exist. This can be used with command that
-  only produce a correction when differences are found
+- ``(diff <file1> <file2>)`` is similar to ``(run diff <file1>
+  <file2>)`` but is better and allows promotion.  See `Diffing and
+  promotion`_ for more details
+- ``(diff? <file1> <file2>)`` is the same as ``(diff <file1>
+  <file2>)`` except that it is ignored when ``<file1>`` or ``<file2>``
+  doesn't exists

 As mentioned ``copy#`` inserts a line directive at the beginning of
 the destination file. More precisely, it inserts the following line:
@ -1138,37 +1137,69 @@ is global to all build contexts, simply use an absolute filename:

 .. _ocaml-syntax:

+Diffing and promotion
+---------------------
+
+``(diff <file1> <file2>)`` is very similar to ``(run diff <file1>
+<file2>)``. In particular it behaves in the same way:
+
+- when ``<file1>`` and ``<file2>`` are equal, it doesn't nothing
+- when they are not, the differences are shown and the action fails
+
+However, it is different for the following reason:
+
+- the exact command used to diff files can be configured via the
+  ``--diff-command`` command line argument. Note that it is only
+  called when the files are not byte equals
+
+- by default, it will use ``patdiff`` if it is installed. ``patdiff``
+  is a better diffing program. You can install it via opam with:
+
+  .. code:: sh
+
+     $ opam install patdiff
+
+- since ``(diff a b)`` is a builtin action, Jbuilder knowns that ``a``
+  and ``b`` are needed and so you don't need to specify them
+  explicitly as dependencies
+
+- you can use ``(diff? a b)`` after a command that might or might not
+  produce ``b``. For cases where commands optionally produce a
+  *corrected* file
+
+- it allows promotion. See below
+
 Promotion
---------
+~~~~~~~~~

-The ``(promote (<file1> as <file2>) (<file3> as <file4>) ...)`` and
-``(promote-if (<file1> as <file2>) (<file3> as <file4>) ...)`` actions
-can be used to copy generated files to the source tree.
+Whenever an action ``(diff <file1> <file2>)`` or ``(diff?  <file1>
+<file2>)`` fails because the two files are different, jbuilder allows
+you to promote ``<file2>`` as ``<file1>`` if ``<file1>`` is a source
+file and ``<file2>`` is a generated file.

-This method is used when one wants to commit a generated file that is
-independent of the systems where it is generated. Typically this can
-be used to:
+More precisely, let's consider the following jbuild file:

- cut dependencies and/or speed up the build in release mode: we use
-  the file in the source tree rather than re-generate it
- support bootstrap cycles
- simplify the review when the generated code is easier to review than
-  the generator
+.. code:: scheme

-How jbuilder interprets promotions can be controlled using the
-``--promote`` command line argument. The following behaviors are
-available:
+   (rule
+    (with-stdout-to data.out (run ./test.exe)))

- ``--promote copy``: when the two files given in a ``(<a> as <b>)``
-  form are different, jbuilder prints a diff and copies ``<a>`` to
-  ``<b>`` directly in the source
-   tree. This is the default
- ``--promote check``: Jbuilder just checks that the two files are
-  equal and print a diff when there are not
- ``--promote ignore``: ``promote`` actions are simply ignored
+   (alias
+    ((name   runtest)
+     (action (diff data.expected data.out))))

-Note that ``-p/--for-release-of-packages`` implies ``--promote
-ignore``.
+Where ``data.expected`` is a file committed in the source
+repository. You can use the following workflow to update your test:
+
+- update the code of your test
+- run ``jbuilder runtest``. The diff action will fail and a diff will
+  be printed
+- check the diff to make sure it is what you expect
+- run ``jbuilder promote``. This will copy the generated ``data.out``
+  file to ``data.expected`` directly in the source tree
+
+You can also use ``jbuilder runtest --auto-promote`` which will
+automatically do the promotion.

 OCaml syntax
 ============
--- a/src/action.ml
+++ b/src/action.ml
@ -12,8 +12,6 @@ module Outputs = struct
    | Outputs -> "outputs"
 end

-module Promote_mode = Action_intf.Promote_mode
-
 module type Sexpable = sig
  type t
  val t : t Sexp.Of_sexp.t
@ -31,14 +29,6 @@ module Make_ast
 struct
  include Ast

-  let promoted_file sexp =
-    match sexp with
-    | List (_, [src; Atom (_, "as"); dst]) ->
-      { Promote. src = Path.t src; dst = Path.t dst }
-    | _ ->
-      of_sexp_error sexp
-        "(<file1> as <file2>) expected"
-
  let rec t sexp =
    let path = Path.t and string = String.t in
    sum
@ -69,16 +59,13 @@ struct
      ; cstr "system" (string @> nil) (fun cmd -> System cmd)
      ; cstr "bash"   (string @> nil) (fun cmd -> Bash   cmd)
      ; cstr "write-file" (path @> string @> nil) (fun fn s -> Write_file (fn, s))
-      ; cstr_rest "promote" nil promoted_file
-          (fun files -> Promote { mode = Always; files })
-      ; cstr_rest "promote-if" nil promoted_file
-          (fun files -> Promote { mode = If_corrected_file_exists; files })
+      ; cstr "diff" (path @> path @> nil)
+          (fun file1 file2 -> Diff { optional = false; file1; file2 })
+      ; cstr "diff?" (path @> path @> nil)
+          (fun file1 file2 -> Diff { optional = true ; file1; file2 })
      ]
      sexp

-  let sexp_of_promoted_file (file : Promote.file) =
-    Sexp.List [Path.sexp_of_t file.src; Atom "as"; Path.sexp_of_t file.dst]
-
  let rec sexp_of_t : _ -> Sexp.t =
    let path = Path.sexp_of_t and string = String.sexp_of_t in
    function
@ -110,10 +97,10 @@ struct
    | Remove_tree x -> List [Atom "remove-tree"; path x]
    | Mkdir x       -> List [Atom "mkdir"; path x]
    | Digest_files paths -> List [Atom "digest-files"; List (List.map paths ~f:path)]
-    | Promote { mode = Always; files } ->
-      List (Atom "promote" :: List.map files ~f:sexp_of_promoted_file)
-    | Promote { mode = If_corrected_file_exists; files } ->
-      List (Atom "promote-if" :: List.map files ~f:sexp_of_promoted_file)
+    | Diff { optional = false; file1; file2 } ->
+      List [Atom "diff"; path file1; path file2]
+    | Diff { optional = true; file1; file2 } ->
+      List [Atom "diff?"; path file1; path file2]

  let run prog args = Run (prog, args)
  let chdir path t = Chdir (path, t)
@ -137,8 +124,7 @@ struct
  let remove_tree path = Remove_tree path
  let mkdir path = Mkdir path
  let digest_files files = Digest_files files
-  let promote files = Promote { mode = Always; files }
-  let promote_if files = Promote { mode = If_corrected_file_exists; files }
+  let diff ?(optional=false) file1 file2 = Diff { optional; file1; file2 }
 end

 module Make_mapper
@ -172,12 +158,8 @@ module Make_mapper
    | Remove_tree x -> Remove_tree (f_path x)
    | Mkdir x -> Mkdir (f_path x)
    | Digest_files x -> Digest_files (List.map x ~f:f_path)
-    | Promote p ->
-      let files =
-        List.map p.files ~f:(fun { Src.Promote. src; dst } ->
-          { Dst.Promote.src = f_path src; dst = f_path dst })
-      in
-      Promote { mode = p.mode; files }
+    | Diff { optional; file1; file2 } ->
+      Diff { optional; file1 = f_path file1; file2 = f_path file2 }
 end

 module Prog = struct
@ -424,15 +406,11 @@ module Unexpanded = struct
        end
      | Digest_files x ->
        Digest_files (List.map x ~f:(E.path ~dir ~f))
-      | Promote p ->
-        let files =
-          List.map p.files ~f:(fun { Promote.src; dst } ->
-            { Unresolved.Promote.
-              src = E.path ~dir ~f src
-            ; dst = Path.drop_build_context (E.path ~dir ~f dst)
-            })
-        in
-        Promote { mode = p.mode; files }
+      | Diff { optional; file1; file2 } ->
+        Diff { optional
+             ; file1 = E.path ~dir ~f file1
+             ; file2 = E.path ~dir ~f file2
+             }
  end

  module E = struct
@ -534,15 +512,11 @@ module Unexpanded = struct
      Mkdir res
    | Digest_files x ->
      Digest_files (List.map x ~f:(E.path ~dir ~f))
-    | Promote p ->
-      let files =
-        List.map p.files ~f:(fun { Promote.src; dst } ->
-          { Partial.Promote.
-            src = E.path ~dir ~f src
-          ; dst = E.path ~dir ~f dst
-          })
-      in
-      Promote { mode = p.mode; files }
+    | Diff { optional; file1; file2 } ->
+      Diff { optional
+           ; file1 = E.path ~dir ~f file1
+           ; file2 = E.path ~dir ~f file2
+           }
 end

 let fold_one_step t ~init:acc ~f =
@ -565,7 +539,7 @@ let fold_one_step t ~init:acc ~f =
  | Remove_tree _
  | Mkdir _
  | Digest_files _
-  | Promote _ -> acc
+  | Diff _ -> acc

 include Make_mapper(Ast)(Ast)

@ -597,6 +571,89 @@ let get_std_output : _ -> Future.std_output_to = function
  | None          -> Terminal
  | Some (fn, oc) -> Opened_file { filename = fn; tail = false; desc = Channel oc }

+module Promotion = struct
+  module File = struct
+    type t =
+      { src : Path.t
+      ; dst : Path.t
+      }
+
+    let t = function
+      | Sexp.Ast.List (_, [src; Atom (_, "as"); dst]) ->
+        { src = Path.t src
+        ; dst = Path.t dst
+        }
+      | sexp ->
+        Sexp.Of_sexp.of_sexp_errorf sexp "(<file> as <file>) expected"
+
+    let sexp_of_t { src; dst } =
+      Sexp.List [Path.sexp_of_t src; Atom "as"; Path.sexp_of_t dst]
+
+    let db : t list ref = ref []
+
+    let register t = db := t :: !db
+
+    let promote { src; dst } =
+      Format.eprintf "Promoting %s to %s.@."
+        (Path.to_string_maybe_quoted src)
+        (Path.to_string_maybe_quoted dst);
+      Io.copy_file
+        ~src:(Path.to_string src)
+        ~dst:(Path.to_string dst)
+  end
+
+  let db_file = "_build/.to-promote"
+
+  let dump_db db =
+    if Sys.file_exists "_build" then begin
+      match db with
+      | [] -> if Sys.file_exists db_file then Sys.remove db_file
+      | l ->
+        Io.write_file db_file
+          (String.concat ~sep:""
+             (List.map l ~f:(fun x -> Sexp.to_string (File.sexp_of_t x) ^ "\n")))
+    end
+
+  let load_db () =
+    if Sys.file_exists db_file then
+      Sexp.load ~fname:db_file ~mode:Many
+      |> List.map ~f:File.t
+    else
+      []
+
+  let group_by_targets db =
+    List.map db ~f:(fun { File. src; dst } ->
+      (dst, src))
+    |> Path.Map.of_alist_multi
+    (* Sort the list of possible sources for deterministic behavior *)
+    |> Path.Map.map ~f:(List.sort ~cmp:Path.compare)
+
+  let do_promote db =
+    let by_targets = group_by_targets db  in
+    Path.Map.iter by_targets ~f:(fun ~key:dst ~data:srcs ->
+      match srcs with
+      | [] -> assert false
+      | src :: others ->
+        File.promote { src; dst };
+        List.iter others ~f:(fun path ->
+          Format.eprintf " -> ignored %s.@."
+            (Path.to_string_maybe_quoted path)))
+
+  let finalize () =
+    let db =
+      if !Clflags.auto_promote then
+        (do_promote !File.db; [])
+      else
+        !File.db
+    in
+    dump_db db
+
+  let promote_files_registered_in_last_run () =
+    let db = load_db () in
+    do_promote db;
+    dump_db []
+end
+
 type exec_context =
  { context : Context.t option
  ; purpose : Future.purpose
@ -688,7 +745,7 @@ let rec exec t ~ectx ~dir ~env_extra ~stdout_to ~stderr_to =
  | Copy_and_add_line_directive (src, dst) ->
    Io.with_file_in (Path.to_string src) ~f:(fun ic ->
      Io.with_file_out (Path.to_string dst) ~f:(fun oc ->
-        let fn = Path.drop_build_context src in
+        let fn = Path.drop_optional_build_context src in
        let directive =
          if List.mem (Path.extension fn) ~set:[".c"; ".cpp"; ".h"] then
            "line"
@ -736,37 +793,24 @@ let rec exec t ~ectx ~dir ~env_extra ~stdout_to ~stderr_to =
        (Marshal.to_string data [])
    in
    exec_echo stdout_to s
-  | Promote { mode; files } ->
-    let promote_mode = !Clflags.promote_mode in
-    if promote_mode = Ignore then
+  | Diff { optional; file1; file2 } ->
+    if (optional && not (Path.exists file1 && Path.exists file2)) ||
+       Io.read_file (Path.to_string file1) = Io.read_file (Path.to_string file2) then
      return ()
    else begin
-      let files =
-        match mode with
-        | Always -> files
-        | If_corrected_file_exists ->
-          List.filter files ~f:(fun file -> Path.exists file.Promote.src)
+      let is_copied_from_source_tree file =
+        match Path.drop_build_context file with
+        | None -> false
+        | Some file -> Path.exists file
      in
-      let not_ok =
-        List.filter files ~f:(fun { Promote. src; dst } ->
-          let src_contents = Io.read_file (Path.to_string src) in
-          let dst_contents = Io.read_file (Path.to_string dst) in
-          src_contents <> dst_contents)
-      in
-      match not_ok with
-      | [] -> return ()
-      | _ ->
-        if promote_mode = Copy then
-          Future.Scheduler.at_exit_after_waiting_for_commands (fun () ->
-            List.iter not_ok ~f:(fun { Promote. src; dst } ->
-              if mode = Always || Path.exists dst then begin
-                Format.eprintf "Promoting %s to %s.@."
-                  (Path.to_string_maybe_quoted src)
-                  (Path.to_string_maybe_quoted dst);
-                Io.copy_file ~src:(Path.to_string src) ~dst:(Path.to_string dst)
-              end));
-        Future.all_unit (List.map not_ok ~f:(fun { Promote. src; dst } ->
-          Diff.print dst src))
+      if is_copied_from_source_tree file1 &&
+         not (is_copied_from_source_tree file2) then begin
+        Promotion.File.register
+          { src = file2
+          ; dst = Option.value_exn (Path.drop_build_context file1)
+          }
+      end;
+      Print_diff.print file1 file2
    end

 and redirect outputs fn t ~ectx ~dir ~env_extra ~stdout_to ~stderr_to =
@ -832,13 +876,6 @@ module Infer = struct
  end
  open Outcome

-  let infer_promote mode files ~init ~f =
-    if mode = Promote_mode.If_corrected_file_exists ||
-       !Clflags.promote_mode = Ignore then
-      init
-    else
-      List.fold_left files ~init ~f
-
  let ( +@ ) acc fn = { acc with targets = S.add fn acc.targets }
  let ( +< ) acc fn = { acc with deps    = S.add fn acc.deps    }

@ -858,8 +895,8 @@ module Infer = struct
    | Ignore (_, t) -> infer acc t
    | Progn l -> List.fold_left l ~init:acc ~f:infer
    | Digest_files l -> List.fold_left l ~init:acc ~f:(+<)
-    | Promote { mode; files } ->
-      infer_promote mode files ~init:acc ~f:(fun acc file -> acc +< file.Promote.src)
+    | Diff { optional; file1; file2 } ->
+      if optional then acc else acc +< file1 +< file2
    | Echo _
    | System _
    | Bash _
@ -901,9 +938,8 @@ module Infer = struct
    | Ignore (_, t) -> partial acc t
    | Progn l -> List.fold_left l ~init:acc ~f:partial
    | Digest_files l -> List.fold_left l ~init:acc ~f:(+<?)
-    | Promote { mode; files } ->
-      infer_promote mode files ~init:acc ~f:(fun acc file ->
-        acc +<? file.Unexpanded.Partial.Promote.src)
+    | Diff { optional; file1; file2 } ->
+      if optional then acc else acc +<? file1 +<? file2
    | Echo _
    | System _
    | Bash _
@ -931,9 +967,8 @@ module Infer = struct
    | Ignore (_, t) -> partial_with_all_targets acc t
    | Progn l -> List.fold_left l ~init:acc ~f:partial_with_all_targets
    | Digest_files l -> List.fold_left l ~init:acc ~f:(+<?)
-    | Promote { mode; files } ->
-      infer_promote mode files ~init:acc ~f:(fun acc file ->
-        acc +<? file.Unexpanded.Partial.Promote.src)
+    | Diff { optional; file1; file2 } ->
+      if optional then acc else acc +<? file1 +<? file2
    | Echo _
    | System _
    | Bash _
--- a/src/action.mli
+++ b/src/action.mli
@ -14,8 +14,6 @@ end

 module Outputs : module type of struct include Action_intf.Outputs end

-module Promote_mode = Action_intf.Promote_mode
-
 (** result of the lookup of a program, the path to it or information about the
    failure and possibly a hint how to fix it *)
 module Prog : sig
@ -38,11 +36,10 @@ include Action_intf.Ast
  with type string  := string

 include Action_intf.Helpers
-  with type program      := Prog.t
-  with type path         := Path.t
-  with type string       := string
-  with type promote_file := Promote.file
-  with type t            := t
+  with type program := Prog.t
+  with type path    := Path.t
+  with type string  := string
+  with type t       := t

 val t : t Sexp.Of_sexp.t
 val sexp_of_t : t Sexp.To_sexp.t
@ -130,3 +127,21 @@ module Infer : sig
  (** If [all_targets] is [true] and a target cannot be determined statically, fail *)
  val partial : all_targets:bool -> Unexpanded.Partial.t -> Outcome.t
 end
+
+module Promotion : sig
+  module File : sig
+    type t =
+      { src : Path.t
+      ; dst : Path.t
+      }
+
+    (** Register a file to promote *)
+    val register : t -> unit
+  end
+
+  (** Promote all registered files if [!Clflags.auto_promote]. Otherwise dump the list of
+      registered files to [_build/.to-promote]. *)
+  val finalize : unit -> unit
+
+  val promote_files_registered_in_last_run : unit -> unit
+end
--- a/src/action_intf.ml
+++ b/src/action_intf.ml
@ -5,23 +5,18 @@ module Outputs = struct
    | Outputs (** Both Stdout and Stderr *)
 end

-module Promote_mode = struct
-  type t =
-    | If_corrected_file_exists
-    | Always
-end
-
 module type Ast = sig
  type program
  type path
  type string

-  module Promote : sig
+  module Diff : sig
    type file = { src : path; dst : path }

    type t =
-      { mode  : Promote_mode.t
-      ; files : file list
+      { optional : bool
+      ; file1    : path
+      ; file2    : path
      }
  end

@ -44,7 +39,7 @@ module type Ast = sig
    | Remove_tree    of path
    | Mkdir          of path
    | Digest_files   of path list
-    | Promote        of Promote.t
+    | Diff           of Diff.t
 end

 module type Helpers = sig
@ -52,7 +47,6 @@ module type Helpers = sig
  type path
  type string
  type t
-  type promote_file

  val run : program -> string list -> t
  val chdir : path -> t -> t
@ -76,6 +70,5 @@ module type Helpers = sig
  val remove_tree : path -> t
  val mkdir : path -> t
  val digest_files : path list -> t
-  val promote : promote_file list -> t
-  val promote_if : promote_file list -> t
+  val diff : ?optional:bool -> Path.t -> Path.t -> t
 end
--- a/src/alias.ml
+++ b/src/alias.ml
@ -51,7 +51,7 @@ let is_standard = function
  | _ -> false

 let dep_rec ~loc ~file_tree t =
-  let path = Path.parent   (Fq_name.path t.name) |> Path.drop_build_context in
+  let path = Path.parent   (Fq_name.path t.name) |> Path.drop_optional_build_context in
  let name = Path.basename (Fq_name.path t.name) in
  match File_tree.find_dir file_tree path with
  | None -> Build.fail { fail = fun () ->
--- a/src/build_system.ml
+++ b/src/build_system.ml
@ -87,7 +87,7 @@ module Internal_rule = struct
    | None ->
      Loc.in_file
        (Path.to_string
-           (Path.drop_build_context (Path.relative dir "jbuild")))
+           (Path.drop_optional_build_context (Path.relative dir "jbuild")))
 end

 module File_kind = struct
@ -339,7 +339,7 @@ let add_spec t fn spec ~copy_source =
           | Yes _ -> assert false
           | Not_possible ->
             Format.fprintf ppf "Delete file %s to get rid of this warning."
-               (Path.to_string_maybe_quoted (Path.drop_build_context fn))
+               (Path.to_string_maybe_quoted (Path.drop_optional_build_context fn))
           | No ->
             Format.fprintf ppf
               "To keep the current behavior and get rid of this warning, add a field \
@ -663,7 +663,7 @@ let create ~contexts ~file_tree ~rules =
         Pset.elements set
         |> List.map ~f:(fun p -> sprintf "- %s"
                                    (Path.to_string_maybe_quoted
-                                       (Path.drop_build_context p)))
+                                       (Path.drop_optional_build_context p)))
         |> String.concat ~sep:"\n"
       in
       Loc.fail (Internal_rule.loc rule ~dir:(Path.parent (Pset.choose leftover_targets)))
@ -684,6 +684,7 @@ The following targets are not:
   ));

  at_exit (fun () -> dump_trace t);
+  Future.Scheduler.at_exit_after_waiting_for_commands Action.Promotion.finalize;
  t

 let remove_old_artifacts t =
--- a/src/clflags.ml
+++ b/src/clflags.ml
@ -11,21 +11,4 @@ let external_lib_deps_hint = ref []
 let capture_outputs = ref true
 let debug_backtraces = ref false
 let diff_command = ref None
-module Promote_mode = struct
-  type t =
-    | Ignore
-    | Check
-    | Copy
-
-  let to_string = function
-    | Ignore -> "ignore"
-    | Check -> "check"
-    | Copy -> "copy"
-
-  let of_string = function
-    | "ignore" -> Some Ignore
-    | "check" -> Some Check
-    | "copy" -> Some Copy
-    | _ -> None
-end
-let promote_mode = ref Promote_mode.Copy
+let auto_promote = ref false
--- a/src/clflags.mli
+++ b/src/clflags.mli
@ -39,15 +39,5 @@ val debug_backtraces : bool ref
 (** Command to use to diff things *)
 val diff_command : string option ref

-module Promote_mode : sig
-  type t =
-    | Ignore (** We ignore 'promote' stanzas and actions *)
-    | Check  (** Just check for equality *)
-    | Copy   (** If the correction is different,
-                 copy the file to the source tree *)
-
-  val to_string : t -> string
-  val of_string : string -> t option
-end
-
-val promote_mode : Promote_mode.t ref
+(** Automatically promote files *)
+val auto_promote : bool ref
--- a/src/diff.ml
+++ b/src/diff.ml
@ -1,43 +0,0 @@
-open Import
-
-let ( >>= ) = Future.( >>= )
-
-let print file1 file2 =
-  let loc = Loc.in_file (Path.to_string file1) in
-  let fallback () =
-    die "%aFiles \"%s\" and \"%s\" differ." Loc.print loc
-      (Path.to_string file1) (Path.to_string file2)
-  in
-  let normal_diff () =
-    match Bin.which "diff" with
-    | None -> fallback ()
-    | Some prog ->
-      Format.eprintf "%a@?" Loc.print loc;
-      Future.run Strict (Path.to_string prog)
-        ["-u"; Path.to_string file1; Path.to_string file2]
-      >>= fun () ->
-      die "diff reported no differences on \"%s\" and \"%s\""
-        (Path.to_string file1) (Path.to_string file2)
-  in
-  match !Clflags.diff_command with
-  | Some cmd ->
-    let sh, arg = Utils.system_shell_exn ~needed_to:"print diffs" in
-    let q fn = Filename.quote (Path.to_string fn) in
-    let cmd = sprintf "%s %s %s" cmd (q file1) (q file2) in
-    Future.run Strict (Path.to_string sh) [arg; cmd]
-    >>= fun () ->
-    die "command reported no differences: %s" cmd
-  | None ->
-    match Bin.which "patdiff" with
-    | None -> normal_diff ()
-    | Some prog ->
-      Future.run Strict (Path.to_string prog)
-        [ "-keep-whitespace"
-        ; "-location-style"; "omake"
-        ; "-unrefined"
-        ; Path.to_string file1
-        ; Path.to_string file2
-        ]
-      >>= fun () ->
-      (* Use "diff" if "patdiff" reported no differences *)
-      normal_diff ()
--- a/src/main.ml
+++ b/src/main.ml
@ -150,7 +150,7 @@ let report_error ?(map_fname=fun x->x) ppf exn ~backtrace =
       - external library %S is required in %s\n\
       This cannot work.\n"
      package
-      (Utils.jbuild_name_in ~dir:(Path.drop_build_context defined_locally_in))
+      (Utils.jbuild_name_in ~dir:(Path.drop_optional_build_context defined_locally_in))
      required_by
      required_by
      (Utils.jbuild_name_in ~dir:required_locally_in);
--- a/src/merlin.ml
+++ b/src/merlin.ml
@ -44,7 +44,7 @@ let dot_merlin sctx ~dir ({ requires; flags; _ } as t) =
            function
            | Lib.Internal (path, _) ->
              let spath =
-                Path.drop_build_context path
+                Path.drop_optional_build_context path
                |> Path.reach ~from:remaindir
              in
              let bpath = Path.reach path ~from:remaindir in
--- a/src/path.ml
+++ b/src/path.ml
@ -378,6 +378,9 @@ let extract_build_context_dir t =
    None

 let drop_build_context t =
+  Option.map (extract_build_context t) ~f:snd
+
+let drop_optional_build_context t =
  match extract_build_context t with
  | None -> t
  | Some (_, t) -> t
--- a/src/path.mli
+++ b/src/path.mli
@ -98,7 +98,10 @@ val extract_build_context : t -> (string * t) option
 val extract_build_context_dir : t -> (t * t) option

 (** Drop the "_build/blah" prefix *)
-val drop_build_context : t -> t
+val drop_build_context : t -> t option
+
+(** Drop the "_build/blah" prefix if present, return [t] otherwise *)
+val drop_optional_build_context : t -> t

 val is_in_build_dir : t -> bool

--- a/src/print_diff.ml
+++ b/src/print_diff.ml
@ -0,0 +1,58 @@
+open Import
+
+let ( >>= ) = Future.( >>= )
+
+let print path1 path2 =
+  let dir, file1, file2 =
+    match
+      Path.extract_build_context_dir path1,
+      Path.extract_build_context_dir path2
+    with
+    | Some (dir1, f1), Some (dir2, f2) when dir1 = dir2 ->
+      (Path.to_string dir1, Path.to_string f1, Path.to_string f2)
+    | _ ->
+      (".", Path.to_string path1, Path.to_string path2)
+  in
+  let loc = Loc.in_file file1 in
+  let fallback () =
+    die "%aFiles %s and %s differ." Loc.print loc
+      (Path.to_string_maybe_quoted path1)
+      (Path.to_string_maybe_quoted path2)
+  in
+  let normal_diff () =
+    match Bin.which "diff" with
+    | None -> fallback ()
+    | Some prog ->
+      Format.eprintf "%a@?" Loc.print loc;
+      Future.run ~dir Strict (Path.to_string prog)
+        ["-u"; file1; file2]
+      >>= fun () ->
+      fallback ()
+  in
+  match !Clflags.diff_command with
+  | Some cmd ->
+    let sh, arg = Utils.system_shell_exn ~needed_to:"print diffs" in
+    let cmd =
+      sprintf "%s %s %s" cmd (quote_for_shell file1) (quote_for_shell file2)
+    in
+    Future.run ~dir Strict (Path.to_string sh) [arg; cmd]
+    >>= fun () ->
+    die "command reported no differences: %s"
+      (if dir = "." then
+         cmd
+       else
+         sprintf "cd %s && %s" (quote_for_shell dir) cmd)
+  | None ->
+    match Bin.which "patdiff" with
+    | None -> normal_diff ()
+    | Some prog ->
+      Future.run ~dir Strict (Path.to_string prog)
+        [ "-keep-whitespace"
+        ; "-location-style"; "omake"
+        ; "-unrefined"
+        ; file1
+        ; file2
+        ]
+      >>= fun () ->
+      (* Use "diff" if "patdiff" reported no differences *)
+      normal_diff ()
--- a/src/print_diff.mli
+++ b/src/print_diff.mli
--- a/src/super_context.ml
+++ b/src/super_context.ml
@ -924,10 +924,9 @@ module PP = struct
      Build.progn
        [ build
        ; Build.return
-            (A.promote_if
-               [{ src = Path.extend_basename fn ~suffix:".ppx-corrected"
-                ; dst = Path.drop_build_context fn
-                }])
+            (A.diff ~optional:true
+               (Path.extend_basename fn ~suffix:".ppx-corrected")
+               fn)
        ]

  let lint_module sctx ~(source : Module.t) ~(ast : Module.t) ~dir
--- a/test/blackbox-tests/jbuild
+++ b/test/blackbox-tests/jbuild
@ -11,21 +11,30 @@
  (deps   ((files_recursively_in test-cases/redirections)))
  (action
   (chdir test-cases/redirections
-    (setenv JBUILDER ${bin:jbuilder} (run ${exe:cram.exe} run.t))))))
+    (setenv JBUILDER ${bin:jbuilder}
+     (progn
+      (run ${exe:cram.exe} run.t)
+      (diff? run.t run.t.corrected)))))))

 (alias
 ((name runtest)
  (deps ((files_recursively_in test-cases/misc)))
  (action
   (chdir test-cases/misc
-    (setenv JBUILDER ${bin:jbuilder} (run ${exe:cram.exe} run.t))))))
+    (setenv JBUILDER ${bin:jbuilder}
+     (progn
+      (run ${exe:cram.exe} run.t)
+      (diff? run.t run.t.corrected)))))))

 (alias
 ((name runtest)
  (deps ((files_recursively_in test-cases/github20)))
  (action
   (chdir test-cases/github20
-    (setenv JBUILDER ${bin:jbuilder} (run ${exe:cram.exe} run.t))))))
+    (setenv JBUILDER ${bin:jbuilder}
+     (progn
+      (run ${exe:cram.exe} run.t)
+      (diff? run.t run.t.corrected)))))))

 (alias
 ((name runtest-js)
@ -34,21 +43,29 @@
   (chdir test-cases/js_of_ocaml
    (setenv JBUILDER ${bin:jbuilder}
     (setenv NODE ${bin:node}
-      (run ${exe:cram.exe} run.t)))))))
+      (progn
+       (run ${exe:cram.exe} run.t)
+       (diff? run.t run.t.corrected))))))))

 (alias
 ((name runtest)
  (deps ((files_recursively_in test-cases/github24)))
  (action
   (chdir test-cases/github24
-    (setenv JBUILDER ${bin:jbuilder} (run ${exe:cram.exe} run.t))))))
+    (setenv JBUILDER ${bin:jbuilder}
+     (progn
+      (run ${exe:cram.exe} run.t)
+      (diff? run.t run.t.corrected)))))))

 (alias
 ((name runtest)
  (deps ((files_recursively_in test-cases/menhir)))
  (action
   (chdir test-cases/menhir
-    (setenv JBUILDER ${bin:jbuilder} (run ${exe:cram.exe} run.t))))))
+    (setenv JBUILDER ${bin:jbuilder}
+     (progn
+      (run ${exe:cram.exe} run.t)
+      (diff? run.t run.t.corrected)))))))

 (alias
 ((name runtest)
@ -56,123 +73,177 @@
  (action
   (chdir test-cases/github25/root
    (setenv OCAMLPATH ../findlib-packages
-     (setenv JBUILDER ${bin:jbuilder} (run ${exe:cram.exe} run.t)))))))
+     (setenv JBUILDER ${bin:jbuilder}
+      (progn
+       (run ${exe:cram.exe} run.t)
+       (diff? run.t run.t.corrected))))))))

 (alias
 ((name runtest)
  (deps ((files_recursively_in test-cases/lib-available)))
  (action
   (chdir test-cases/lib-available
-    (setenv JBUILDER ${bin:jbuilder} (run ${exe:cram.exe} run.t))))))
+    (setenv JBUILDER ${bin:jbuilder}
+     (progn
+      (run ${exe:cram.exe} run.t)
+      (diff? run.t run.t.corrected)))))))

 (alias
 ((name runtest)
  (deps ((files_recursively_in test-cases/copy_files)))
  (action
   (chdir test-cases/copy_files
-    (setenv JBUILDER ${bin:jbuilder} (run ${exe:cram.exe} run.t))))))
+    (setenv JBUILDER ${bin:jbuilder}
+     (progn
+      (run ${exe:cram.exe} run.t)
+      (diff? run.t run.t.corrected)))))))

 (alias
 ((name runtest)
  (deps ((files_recursively_in test-cases/aliases)))
  (action
   (chdir test-cases/aliases
-    (setenv JBUILDER ${bin:jbuilder} (run ${exe:cram.exe} run.t))))))
+    (setenv JBUILDER ${bin:jbuilder}
+     (progn
+      (run ${exe:cram.exe} run.t)
+      (diff? run.t run.t.corrected)))))))

 (alias
 ((name runtest)
  (deps ((files_recursively_in test-cases/force-test)))
  (action
   (chdir test-cases/force-test
-    (setenv JBUILDER ${bin:jbuilder} (run ${exe:cram.exe} run.t))))))
+    (setenv JBUILDER ${bin:jbuilder}
+     (progn
+      (run ${exe:cram.exe} run.t)
+      (diff? run.t run.t.corrected)))))))

 (alias
 ((name runtest)
  (deps ((files_recursively_in test-cases/meta-gen)))
  (action
   (chdir test-cases/meta-gen
-    (setenv JBUILDER ${bin:jbuilder} (run ${exe:cram.exe} run.t))))))
+    (setenv JBUILDER ${bin:jbuilder}
+     (progn
+      (run ${exe:cram.exe} run.t)
+      (diff? run.t run.t.corrected)))))))

 (alias
 ((name runtest)
  (deps ((files_recursively_in test-cases/exec-cmd)))
  (action
   (chdir test-cases/exec-cmd
-    (setenv JBUILDER ${bin:jbuilder} (run ${exe:cram.exe} run.t))))))
+    (setenv JBUILDER ${bin:jbuilder}
+     (progn
+      (run ${exe:cram.exe} run.t)
+      (diff? run.t run.t.corrected)))))))

 (alias
 ((name runtest)
  (deps ((files_recursively_in test-cases/ocaml-syntax)))
  (action
     (chdir test-cases/ocaml-syntax
-  (setenv JBUILDER ${bin:jbuilder} (run ${exe:cram.exe} run.t))))))
+      (setenv JBUILDER ${bin:jbuilder}
+       (progn
+        (run ${exe:cram.exe} run.t)
+        (diff? run.t run.t.corrected)))))))

 (alias
 ((name runtest)
  (deps ((files_recursively_in test-cases/gen-opam-install-file)))
  (action
     (chdir test-cases/gen-opam-install-file
-  (setenv JBUILDER ${bin:jbuilder} (run ${exe:cram.exe} run.t))))))
+      (setenv JBUILDER ${bin:jbuilder}
+       (progn
+        (run ${exe:cram.exe} run.t)
+        (diff? run.t run.t.corrected)))))))

 (alias
 ((name runtest)
  (deps ((files_recursively_in test-cases/reason)))
  (action
   (chdir test-cases/reason
-    (setenv JBUILDER ${bin:jbuilder} (run ${exe:cram.exe} run.t))))))
+    (setenv JBUILDER ${bin:jbuilder}
+     (progn
+      (run ${exe:cram.exe} run.t)
+      (diff? run.t run.t.corrected)))))))

 (alias
 ((name runtest)
  (deps ((files_recursively_in test-cases/odoc)))
  (action
   (chdir test-cases/odoc
-    (setenv JBUILDER ${bin:jbuilder} (run ${exe:cram.exe} -ocamlv ${ocaml_version} -skip-versions 4.02.3 run.t))))))
+    (setenv JBUILDER ${bin:jbuilder}
+     (progn
+      (run ${exe:cram.exe} -ocamlv ${ocaml_version} -skip-versions 4.02.3 run.t)
+      (diff? run.t run.t.corrected)))))))

 (alias
 ((name runtest)
  (deps ((files_recursively_in test-cases/select)))
  (action
   (chdir test-cases/select
-    (setenv JBUILDER ${bin:jbuilder} (run ${exe:cram.exe} run.t))))))
+    (setenv JBUILDER ${bin:jbuilder}
+     (progn
+      (run ${exe:cram.exe} run.t)
+      (diff? run.t run.t.corrected)))))))

 (alias
 ((name runtest)
  (deps ((files_recursively_in test-cases/multiple-private-libs)))
  (action
   (chdir test-cases/multiple-private-libs
-    (setenv JBUILDER ${bin:jbuilder} (run ${exe:cram.exe} -ocamlv ${ocaml_version} -skip-versions 4.02.3 run.t))))))
+    (setenv JBUILDER ${bin:jbuilder}
+     (progn
+      (run ${exe:cram.exe} -ocamlv ${ocaml_version} -skip-versions 4.02.3 run.t)
+      (diff? run.t run.t.corrected)))))))

 (alias
 ((name runtest)
  (deps ((files_recursively_in test-cases/ppx-rewriter)))
  (action
   (chdir test-cases/ppx-rewriter
-    (setenv JBUILDER ${bin:jbuilder} (run ${exe:cram.exe} -ocamlv ${ocaml_version} -skip-versions 4.02.3 run.t))))))
+    (setenv JBUILDER ${bin:jbuilder}
+     (progn
+      (run ${exe:cram.exe} -ocamlv ${ocaml_version} -skip-versions 4.02.3 run.t)
+      (diff? run.t run.t.corrected)))))))

 (alias
 ((name runtest)
  (deps ((files_recursively_in test-cases/utop)))
  (action
   (chdir test-cases/utop
-    (setenv JBUILDER ${bin:jbuilder} (run ${exe:cram.exe} run.t))))))
+    (setenv JBUILDER ${bin:jbuilder}
+     (progn
+      (run ${exe:cram.exe} run.t)
+      (diff? run.t run.t.corrected)))))))

 (alias
 ((name runtest)
  (deps ((files_recursively_in test-cases/c-stubs)))
  (action
   (chdir test-cases/c-stubs
-    (setenv JBUILDER ${bin:jbuilder} (run ${exe:cram.exe} run.t))))))
+    (setenv JBUILDER ${bin:jbuilder}
+     (progn
+      (run ${exe:cram.exe} run.t)
+      (diff? run.t run.t.corrected)))))))

 (alias
 ((name runtest)
  (deps ((files_recursively_in test-cases/cross-compilation)))
  (action
   (chdir test-cases/cross-compilation
-    (setenv JBUILDER ${bin:jbuilder} (run ${exe:cram.exe} run.t))))))
+    (setenv JBUILDER ${bin:jbuilder}
+     (progn
+      (run ${exe:cram.exe} run.t)
+      (diff? run.t run.t.corrected)))))))

 (alias
 ((name runtest)
  (deps ((files_recursively_in test-cases/promote)))
  (action
   (chdir test-cases/promote
-    (setenv JBUILDER ${bin:jbuilder} (run ${exe:cram.exe} run.t))))))
+    (setenv JBUILDER ${bin:jbuilder}
+     (progn
+      (run ${exe:cram.exe} run.t)
+      (diff? run.t run.t.corrected)))))))
--- a/test/blackbox-tests/test-cases/promote/jbuild
+++ b/test/blackbox-tests/test-cases/promote/jbuild
@ -4,4 +4,4 @@

 (alias
 ((name blah)
-  (action (promote (x.gen as x)))))
+  (action (diff x x.gen))))
--- a/test/blackbox-tests/test-cases/promote/run.t
+++ b/test/blackbox-tests/test-cases/promote/run.t
@ -1,21 +1,27 @@
  $ echo titi > x

-  $ $JBUILDER build --root . -j1 --diff-command false @blah --promote check
+  $ $JBUILDER build --root . -j1 --diff-command false @blah 2>&1 | sed 's/.*false.*/DIFF/'
            sh (internal) (exit 1)
-  /usr/bin/sh -c 'false '\''x'\'' '\''_build/default/x.gen'\'''
-  [1]
+  DIFF
  $ cat x
  titi

-  $ $JBUILDER build --root . -j1 --diff-command false @blah --promote ignore
+  $ $JBUILDER promote --root .
+  Promoting _build/default/x.gen to x.
  $ cat x
-  titi
+  toto

  $ $JBUILDER build --root . -j1 --diff-command false @blah
+  $ cat x
+  toto
+
+  $ echo titi > x
+  $ $JBUILDER build --root . -j1 --diff-command false @blah --auto-promote 2>&1 | sed 's/.*false.*/DIFF/'
            sh (internal) (exit 1)
-  /usr/bin/sh -c 'false '\''x'\'' '\''_build/default/x.gen'\'''
+  DIFF
  Promoting _build/default/x.gen to x.
-  [1]
  $ cat x
  toto
  $ $JBUILDER build --root . -j1 --diff-command false @blah
+  $ cat x
+  toto
--- a/test/common/test_common.ml
+++ b/test/common/test_common.ml
@ -1,43 +1,4 @@
-open StdLabels
-
-module Print_diff = struct
-  let patdiff_cmd ~use_color =
-    let args =
-      List.concat [
-        ["-keep-whitespace"];
-        ["-location-style omake"];
-        (if use_color then ["-unrefined"] else ["-ascii"]);
-      ]
-    in
-    String.concat ~sep:" " ("patdiff" :: args)
-
-  let print ?diff_command ?(use_color=false) ~file1 ~file2 () =
-    let exec cmd =
-      let cmd =
-        Printf.sprintf "%s %s %s 1>&2" cmd (Filename.quote file1) (Filename.quote file2)
-      in
-      match Sys.command cmd with
-      | 0 -> true
-      | 1 -> false
-      | n -> Printf.eprintf "%S exited with code %d\n" cmd n; exit 2
-    in
-    match diff_command with
-    | Some s -> ignore (exec s : bool)
-    | None ->
-      let has_patdiff =
-        let dev_null = if Sys.win32 then "nul" else "/dev/null" in
-        Printf.ksprintf Sys.command "patdiff -version > %s 2> %s"
-          dev_null dev_null = 0
-      in
-      if has_patdiff then begin
-        if exec (patdiff_cmd ~use_color) then begin
-          (* Use "diff" if "patdiff" reported no differences *)
-          Printf.eprintf "File \"%s\", line 1, characters 0-0:\n%!" file1;
-          ignore (exec "diff -u" : bool);
-        end
-      end else
-        ignore (exec "diff -u" : bool)
-end
+open! StdLabels

 let read_file file =
  let ic = open_in_bin file in
@ -58,33 +19,11 @@ let run_expect_test file ~f =

  let expected = f file_contents lexbuf in

-  (* Temporary hack, if we are in the default context, put the .corrected in the source
-     tree: *)
-  let concat a b =
-    match b with
-    | ".." -> Filename.dirname a
-    | "."  -> a
-    | _    -> Filename.concat a b
-  in
-  let rec loop path after =
-    let basename = Filename.basename path in
-    if basename = "_build" then
-      match after with
-      | "default" :: after ->
-        List.fold_left after ~init:(Filename.dirname path) ~f:concat
-      | _ ->
-        List.fold_left after ~init:path ~f:concat
-    else
-      loop (Filename.dirname path) (basename :: after)
-  in
-  let file = loop (Filename.concat (Sys.getcwd ()) file) [] in
  let corrected_file = file ^ ".corrected" in
  if file_contents <> expected then begin
    let oc = open_out_bin corrected_file in
    output_string oc expected;
    close_out oc;
-    Print_diff.print () ~file1:file ~file2:corrected_file;
-    exit 1
  end else begin
    if Sys.file_exists corrected_file then Sys.remove corrected_file;
    exit 0
--- a/test/unit-tests/jbuild
+++ b/test/unit-tests/jbuild
@ -15,32 +15,47 @@
         (glob_files ${SCOPE_ROOT}/src/*.cmi)
         (glob_files ${SCOPE_ROOT}/vendor/re/*.cmi)
         (files_recursively_in findlib-db)))
-  (action (chdir ${SCOPE_ROOT} (run ${exe:expect_test.exe} ${<})))))
+  (action (chdir ${SCOPE_ROOT}
+           (progn
+            (run ${exe:expect_test.exe} ${<})
+            (diff? ${<} ${<}.corrected))))))

 (alias
 ((name runtest)
  (deps (filename.mlt
         (glob_files ${SCOPE_ROOT}/src/*.cmi)
         (glob_files ${SCOPE_ROOT}/vendor/re/*.cmi)))
-  (action (chdir ${SCOPE_ROOT} (run ${exe:expect_test.exe} ${<})))))
+  (action (chdir ${SCOPE_ROOT}
+           (progn
+            (run ${exe:expect_test.exe} ${<})
+            (diff? ${<} ${<}.corrected))))))

 (alias
 ((name runtest)
  (deps (import_dot_map.mlt
         (glob_files ${SCOPE_ROOT}/src/*.cmi)
         (glob_files ${SCOPE_ROOT}/vendor/re/*.cmi)))
-  (action (chdir ${SCOPE_ROOT} (run ${exe:expect_test.exe} ${<})))))
+  (action (chdir ${SCOPE_ROOT}
+           (progn
+            (run ${exe:expect_test.exe} ${<})
+            (diff? ${<} ${<}.corrected))))))

 (alias
 ((name runtest)
  (deps (action.mlt
         (glob_files ${SCOPE_ROOT}/src/*.cmi)
         (glob_files ${SCOPE_ROOT}/vendor/re/*.cmi)))
-  (action (chdir ${SCOPE_ROOT} (run ${exe:expect_test.exe} ${<})))))
+  (action (chdir ${SCOPE_ROOT}
+           (progn
+            (run ${exe:expect_test.exe} ${<})
+            (diff? ${<} ${<}.corrected))))))

 (alias
 ((name runtest)
  (deps (path.mlt
         (glob_files ${SCOPE_ROOT}/src/*.cmi)
         (glob_files ${SCOPE_ROOT}/vendor/re/*.cmi)))
-  (action (chdir ${SCOPE_ROOT} (run ${exe:expect_test.exe} ${<})))))
+  (action (chdir ${SCOPE_ROOT}
+           (progn
+            (run ${exe:expect_test.exe} ${<})
+            (diff? ${<} ${<}.corrected))))))