diff --git a/Makefile b/Makefile index c3d6ca44..1096d05b 100644 --- a/Makefile +++ b/Makefile @@ -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 diff --git a/bin/main.ml b/bin/main.ml index 2ed594e8..52c568f0 100644 --- 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 = diff --git a/doc/jbuild b/doc/jbuild index 1cf57295..0964a904 100644 --- 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)))) diff --git a/doc/jbuild.inc b/doc/jbuild.inc index 7e66762b..23a4ec2f 100644 --- 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 ${@} diff --git a/doc/jbuild.rst b/doc/jbuild.rst index 6fd7fdc7..78d3c857 100644 --- 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 )`` to execute a command using ``/bin/bash``. This is obviously not very portable -- ``(promote )`` copy generated files to the source - tree. See `Promotion`_ for more details -- ``(promote-if )`` is the same as ``(promote - )`` except that a form ``( as )`` is ignored - when ```` doesn't exists. Additionally, ```` won't be copied - if ```` doesn't already exist. This can be used with command that - only produce a correction when differences are found +- ``(diff )`` is similar to ``(run diff + )`` but is better and allows promotion. See `Diffing and + promotion`_ for more details +- ``(diff? )`` is the same as ``(diff + )`` except that it is ignored when ```` or ```` + 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 )`` is very similar to ``(run diff +)``. In particular it behaves in the same way: + +- when ```` and ```` 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 ( as ) ( as ) ...)`` and -``(promote-if ( as ) ( as ) ...)`` actions -can be used to copy generated files to the source tree. +Whenever an action ``(diff )`` or ``(diff? +)`` fails because the two files are different, jbuilder allows +you to promote ```` as ```` if ```` is a source +file and ```` 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 ``( as )`` - form are different, jbuilder prints a diff and copies ```` to - ```` 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 ============ diff --git a/src/action.ml b/src/action.ml index 5ca8b94e..457b7b8e 100644 --- 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 - "( as ) 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 "( as ) 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:(+ - infer_promote mode files ~init:acc ~f:(fun acc file -> - acc + + if optional then acc else acc + 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:(+ - infer_promote mode files ~init:acc ~f:(fun acc file -> - acc + + if optional then acc else acc + 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 diff --git a/src/action_intf.ml b/src/action_intf.ml index 9b093d78..5937cc07 100644 --- 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 diff --git a/src/alias.ml b/src/alias.ml index 366eb4bc..7f845722 100644 --- 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 () -> diff --git a/src/build_system.ml b/src/build_system.ml index 6270325d..aceb020e 100644 --- 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 = diff --git a/src/clflags.ml b/src/clflags.ml index e5d34753..d8f99df1 100644 --- 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 diff --git a/src/clflags.mli b/src/clflags.mli index 5579ad02..f0476a51 100644 --- 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 diff --git a/src/diff.ml b/src/diff.ml deleted file mode 100644 index 195200ba..00000000 --- a/src/diff.ml +++ /dev/null @@ -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 () diff --git a/src/main.ml b/src/main.ml index e6b31028..7442ee39 100644 --- 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); diff --git a/src/merlin.ml b/src/merlin.ml index 0351cf70..b25eb1e1 100644 --- 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 diff --git a/src/path.ml b/src/path.ml index 480f4c70..d8e2d68c 100644 --- 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 diff --git a/src/path.mli b/src/path.mli index 0102f0e9..5a5020b0 100644 --- 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 diff --git a/src/print_diff.ml b/src/print_diff.ml new file mode 100644 index 00000000..873412ac --- /dev/null +++ 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 () diff --git a/src/diff.mli b/src/print_diff.mli similarity index 100% rename from src/diff.mli rename to src/print_diff.mli diff --git a/src/super_context.ml b/src/super_context.ml index 8600c0ac..3d149813 100644 --- 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 diff --git a/test/blackbox-tests/jbuild b/test/blackbox-tests/jbuild index 7ef0da97..85eb7ff9 100644 --- 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))))))) diff --git a/test/blackbox-tests/test-cases/promote/jbuild b/test/blackbox-tests/test-cases/promote/jbuild index f5a126ad..82af3d30 100644 --- 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)))) diff --git a/test/blackbox-tests/test-cases/promote/run.t b/test/blackbox-tests/test-cases/promote/run.t index 61ca9625..7c67b02f 100644 --- 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 diff --git a/test/common/test_common.ml b/test/common/test_common.ml index 8a202d58..0e8c4e95 100644 --- 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 diff --git a/test/unit-tests/jbuild b/test/unit-tests/jbuild index f660a4af..f7a03f8f 100644 --- 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))))))