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
This commit is contained in:
parent
9347d4a767
commit
b06aad431e
14
Makefile
14
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
|
||||
|
|
72
bin/main.ml
72
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 =
|
||||
|
|
|
@ -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))))
|
||||
|
|
|
@ -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 ${@}
|
||||
|
|
|
@ -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
|
||||
============
|
||||
|
|
219
src/action.ml
219
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 _
|
||||
|
|
|
@ -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
|
||||
|
@ -41,7 +39,6 @@ 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
|
||||
|
||||
val t : t Sexp.Of_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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 () ->
|
||||
|
|
|
@ -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 =
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
43
src/diff.ml
43
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 ()
|
|
@ -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);
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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 ()
|
|
@ -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
|
||||
|
|
|
@ -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)))))))
|
||||
|
|
|
@ -4,4 +4,4 @@
|
|||
|
||||
(alias
|
||||
((name blah)
|
||||
(action (promote (x.gen as x)))))
|
||||
(action (diff x x.gen))))
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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))))))
|
||||
|
|
Loading…
Reference in New Issue