Add promote actions and include stanzas (#402)
Add a promote action that allows to copy over generated files as source files and an include stanza allowing to include a file in a jbuild file.
This commit is contained in:
parent
f8617b5721
commit
eab1ff6c7b
|
@ -36,6 +36,12 @@ next
|
|||
- Simplify generated META files: do not generate the transitive
|
||||
closure of dependencies in META files (#405)
|
||||
|
||||
- Add an `(include ...)` stanza allowing one to include another
|
||||
non-generated jbuild file in the current file (#402)
|
||||
|
||||
- Add a `(promote (<file1> as <file2>) ...)` action allowing one to
|
||||
promote generated files as source files (#402)
|
||||
|
||||
1.0+beta16 (05/11/2017)
|
||||
-----------------------
|
||||
|
||||
|
|
18
Makefile
18
Makefile
|
@ -33,24 +33,8 @@ clean:
|
|||
doc:
|
||||
cd doc && sphinx-build . _build
|
||||
|
||||
CMDS = $(shell $(BIN) --help=plain | \
|
||||
sed -n '/COMMANDS/,/OPTIONS/p' | sed -En 's/^ ([a-z-]+)/\1/p')
|
||||
|
||||
update-jbuilds: $(BIN)
|
||||
sed -n '1,/;;GENERATED/p' doc/jbuild > doc/jbuild.tmp
|
||||
{ for cmd in $(CMDS); do \
|
||||
echo -ne "\n"\
|
||||
"(rule\n"\
|
||||
" ((targets (jbuilder-$$cmd.1))\n"\
|
||||
" (action (with-stdout-to $$""{@}\n"\
|
||||
" (run $$""{bin:jbuilder} $$cmd --help=groff)))))\n"\
|
||||
"\n"\
|
||||
"(install\n"\
|
||||
" ((section man)\n"\
|
||||
" (files (jbuilder-$$cmd.1))))\n"; \
|
||||
done } >> doc/jbuild.tmp
|
||||
rm -f doc/jbuild
|
||||
mv doc/jbuild.tmp doc/jbuild
|
||||
$(BIN) build --dev @jbuild --promote copy
|
||||
|
||||
accept-corrections:
|
||||
for i in `find . -name \*.corrected`; do \
|
||||
|
|
77
bin/main.ml
77
bin/main.ml
|
@ -22,6 +22,8 @@ type common =
|
|||
; only_packages : String_set.t option
|
||||
; capture_outputs : bool
|
||||
; x : string option
|
||||
; diff_command : string option
|
||||
; promote_mode : Clflags.Promote_mode.t
|
||||
; (* Original arguments for the external-lib-deps hint *)
|
||||
orig_args : string list
|
||||
}
|
||||
|
@ -39,6 +41,8 @@ let set_common c ~targets =
|
|||
if c.root <> Filename.current_dir_name then
|
||||
Sys.chdir c.root;
|
||||
Clflags.workspace_root := Sys.getcwd ();
|
||||
Clflags.diff_command := c.diff_command;
|
||||
Clflags.promote_mode := c.promote_mode;
|
||||
Clflags.external_lib_deps_hint :=
|
||||
List.concat
|
||||
[ ["jbuilder"; "external-lib-deps"; "--missing"]
|
||||
|
@ -156,7 +160,8 @@ let common =
|
|||
verbose
|
||||
no_buffer
|
||||
workspace_file
|
||||
(root, only_packages, orig)
|
||||
diff_command
|
||||
(root, only_packages, promote_mode, orig)
|
||||
x
|
||||
=
|
||||
let root, to_cwd =
|
||||
|
@ -182,6 +187,8 @@ let common =
|
|||
; root
|
||||
; orig_args
|
||||
; target_prefix = String.concat ~sep:"" (List.map to_cwd ~f:(sprintf "%s/"))
|
||||
; diff_command
|
||||
; promote_mode
|
||||
; only_packages =
|
||||
Option.map only_packages
|
||||
~f:(fun s -> String_set.of_list (String.split s ~on:','))
|
||||
|
@ -272,41 +279,66 @@ 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
|
||||
Arg.(value
|
||||
& opt (some mode) None
|
||||
& info ["promote"] ~docs
|
||||
~doc:"How to interpret promote actions. $(b,check), the default, means to
|
||||
only check that promoted files are equal to the source files.
|
||||
$(b,ignore) means to ignore promote action altogether and $(b,copy)
|
||||
means to copy generated files to the source tree.")
|
||||
in
|
||||
let for_release = "for-release-of-packages" in
|
||||
let frop =
|
||||
Arg.(value
|
||||
& opt (some string) None
|
||||
& info ["p"; for_release] ~docs ~docv:"PACKAGES"
|
||||
~doc:{|Shorthand for $(b,--root . --only-packages PACKAGE). You must use
|
||||
this option in your $(i,<package>.opam) files, in order to build
|
||||
only what's necessary when your project contains multiple packages
|
||||
as well as getting reproducible builds.|})
|
||||
~doc:{|Shorthand for $(b,--root . --only-packages PACKAGE --promote ignore).
|
||||
You must use this option in your $(i,<package>.opam) files, in order
|
||||
to build only what's necessary when your project contains multiple
|
||||
packages as well as getting reproducible builds.|})
|
||||
in
|
||||
let root_and_only_packages =
|
||||
let merge root only_packages release =
|
||||
match release, root, only_packages with
|
||||
| Some _, Some _, _ ->
|
||||
let merge root only_packages promote release =
|
||||
let fail opt =
|
||||
`Error (true,
|
||||
sprintf
|
||||
"Cannot use %s and --root simultaneously"
|
||||
for_release)
|
||||
| Some _, _, Some _ ->
|
||||
`Error (true,
|
||||
sprintf
|
||||
"Cannot use %s and --only-packages simultaneously"
|
||||
for_release)
|
||||
| Some pkgs, None, None ->
|
||||
`Ok (Some ".", Some pkgs, ["-p"; pkgs])
|
||||
| None, _, _ ->
|
||||
`Ok (root, only_packages,
|
||||
"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 ->
|
||||
`Ok (Some ".",
|
||||
Some pkgs,
|
||||
Clflags.Promote_mode.Ignore,
|
||||
["-p"; pkgs]
|
||||
)
|
||||
| None, _, _, _ ->
|
||||
`Ok (root,
|
||||
only_packages,
|
||||
Option.value promote ~default:Clflags.Promote_mode.Check,
|
||||
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 =
|
||||
|
@ -315,6 +347,12 @@ let common =
|
|||
& info ["x"] ~docs
|
||||
~doc:{|Cross-compile using this toolchain.|})
|
||||
in
|
||||
let diff_command =
|
||||
Arg.(value
|
||||
& opt (some string) None
|
||||
& info ["diff-command"] ~docs
|
||||
~doc:"Shell command to use to diff files")
|
||||
in
|
||||
Term.(const make
|
||||
$ concurrency
|
||||
$ ddep_path
|
||||
|
@ -324,6 +362,7 @@ let common =
|
|||
$ verbose
|
||||
$ no_buffer
|
||||
$ workspace_file
|
||||
$ diff_command
|
||||
$ root_and_only_packages
|
||||
$ x
|
||||
)
|
||||
|
|
104
doc/jbuild
104
doc/jbuild
|
@ -9,104 +9,12 @@
|
|||
((section man)
|
||||
(files (jbuilder.1))))
|
||||
|
||||
;; Run "make update-jbuilds" to update the rest of this file
|
||||
;;GENERATED
|
||||
(include jbuild.inc)
|
||||
|
||||
(rule
|
||||
((targets (jbuilder-build.1))
|
||||
(action (with-stdout-to ${@}
|
||||
(run ${bin:jbuilder} build --help=groff)))))
|
||||
(with-stdout-to jbuild.inc.gen
|
||||
(run bash ${path:update-jbuild.sh} ${bin:jbuilder})))
|
||||
|
||||
(install
|
||||
((section man)
|
||||
(files (jbuilder-build.1))))
|
||||
|
||||
(rule
|
||||
((targets (jbuilder-clean.1))
|
||||
(action (with-stdout-to ${@}
|
||||
(run ${bin:jbuilder} clean --help=groff)))))
|
||||
|
||||
(install
|
||||
((section man)
|
||||
(files (jbuilder-clean.1))))
|
||||
|
||||
(rule
|
||||
((targets (jbuilder-exec.1))
|
||||
(action (with-stdout-to ${@}
|
||||
(run ${bin:jbuilder} exec --help=groff)))))
|
||||
|
||||
(install
|
||||
((section man)
|
||||
(files (jbuilder-exec.1))))
|
||||
|
||||
(rule
|
||||
((targets (jbuilder-external-lib-deps.1))
|
||||
(action (with-stdout-to ${@}
|
||||
(run ${bin:jbuilder} external-lib-deps --help=groff)))))
|
||||
|
||||
(install
|
||||
((section man)
|
||||
(files (jbuilder-external-lib-deps.1))))
|
||||
|
||||
(rule
|
||||
((targets (jbuilder-install.1))
|
||||
(action (with-stdout-to ${@}
|
||||
(run ${bin:jbuilder} install --help=groff)))))
|
||||
|
||||
(install
|
||||
((section man)
|
||||
(files (jbuilder-install.1))))
|
||||
|
||||
(rule
|
||||
((targets (jbuilder-installed-libraries.1))
|
||||
(action (with-stdout-to ${@}
|
||||
(run ${bin:jbuilder} installed-libraries --help=groff)))))
|
||||
|
||||
(install
|
||||
((section man)
|
||||
(files (jbuilder-installed-libraries.1))))
|
||||
|
||||
(rule
|
||||
((targets (jbuilder-rules.1))
|
||||
(action (with-stdout-to ${@}
|
||||
(run ${bin:jbuilder} rules --help=groff)))))
|
||||
|
||||
(install
|
||||
((section man)
|
||||
(files (jbuilder-rules.1))))
|
||||
|
||||
(rule
|
||||
((targets (jbuilder-runtest.1))
|
||||
(action (with-stdout-to ${@}
|
||||
(run ${bin:jbuilder} runtest --help=groff)))))
|
||||
|
||||
(install
|
||||
((section man)
|
||||
(files (jbuilder-runtest.1))))
|
||||
|
||||
(rule
|
||||
((targets (jbuilder-subst.1))
|
||||
(action (with-stdout-to ${@}
|
||||
(run ${bin:jbuilder} subst --help=groff)))))
|
||||
|
||||
(install
|
||||
((section man)
|
||||
(files (jbuilder-subst.1))))
|
||||
|
||||
(rule
|
||||
((targets (jbuilder-uninstall.1))
|
||||
(action (with-stdout-to ${@}
|
||||
(run ${bin:jbuilder} uninstall --help=groff)))))
|
||||
|
||||
(install
|
||||
((section man)
|
||||
(files (jbuilder-uninstall.1))))
|
||||
|
||||
(rule
|
||||
((targets (jbuilder-utop.1))
|
||||
(action (with-stdout-to ${@}
|
||||
(run ${bin:jbuilder} utop --help=groff)))))
|
||||
|
||||
(install
|
||||
((section man)
|
||||
(files (jbuilder-utop.1))))
|
||||
(alias
|
||||
((name jbuild)
|
||||
(action (promote (jbuild.inc.gen as jbuild.inc)))))
|
||||
|
|
|
@ -0,0 +1,100 @@
|
|||
|
||||
(rule
|
||||
((targets (jbuilder-build.1))
|
||||
(action (with-stdout-to ${@}
|
||||
(run ${bin:jbuilder} build --help=groff)))))
|
||||
|
||||
(install
|
||||
((section man)
|
||||
(files (jbuilder-build.1))))
|
||||
|
||||
(rule
|
||||
((targets (jbuilder-clean.1))
|
||||
(action (with-stdout-to ${@}
|
||||
(run ${bin:jbuilder} clean --help=groff)))))
|
||||
|
||||
(install
|
||||
((section man)
|
||||
(files (jbuilder-clean.1))))
|
||||
|
||||
(rule
|
||||
((targets (jbuilder-exec.1))
|
||||
(action (with-stdout-to ${@}
|
||||
(run ${bin:jbuilder} exec --help=groff)))))
|
||||
|
||||
(install
|
||||
((section man)
|
||||
(files (jbuilder-exec.1))))
|
||||
|
||||
(rule
|
||||
((targets (jbuilder-external-lib-deps.1))
|
||||
(action (with-stdout-to ${@}
|
||||
(run ${bin:jbuilder} external-lib-deps --help=groff)))))
|
||||
|
||||
(install
|
||||
((section man)
|
||||
(files (jbuilder-external-lib-deps.1))))
|
||||
|
||||
(rule
|
||||
((targets (jbuilder-install.1))
|
||||
(action (with-stdout-to ${@}
|
||||
(run ${bin:jbuilder} install --help=groff)))))
|
||||
|
||||
(install
|
||||
((section man)
|
||||
(files (jbuilder-install.1))))
|
||||
|
||||
(rule
|
||||
((targets (jbuilder-installed-libraries.1))
|
||||
(action (with-stdout-to ${@}
|
||||
(run ${bin:jbuilder} installed-libraries --help=groff)))))
|
||||
|
||||
(install
|
||||
((section man)
|
||||
(files (jbuilder-installed-libraries.1))))
|
||||
|
||||
(rule
|
||||
((targets (jbuilder-rules.1))
|
||||
(action (with-stdout-to ${@}
|
||||
(run ${bin:jbuilder} rules --help=groff)))))
|
||||
|
||||
(install
|
||||
((section man)
|
||||
(files (jbuilder-rules.1))))
|
||||
|
||||
(rule
|
||||
((targets (jbuilder-runtest.1))
|
||||
(action (with-stdout-to ${@}
|
||||
(run ${bin:jbuilder} runtest --help=groff)))))
|
||||
|
||||
(install
|
||||
((section man)
|
||||
(files (jbuilder-runtest.1))))
|
||||
|
||||
(rule
|
||||
((targets (jbuilder-subst.1))
|
||||
(action (with-stdout-to ${@}
|
||||
(run ${bin:jbuilder} subst --help=groff)))))
|
||||
|
||||
(install
|
||||
((section man)
|
||||
(files (jbuilder-subst.1))))
|
||||
|
||||
(rule
|
||||
((targets (jbuilder-uninstall.1))
|
||||
(action (with-stdout-to ${@}
|
||||
(run ${bin:jbuilder} uninstall --help=groff)))))
|
||||
|
||||
(install
|
||||
((section man)
|
||||
(files (jbuilder-uninstall.1))))
|
||||
|
||||
(rule
|
||||
((targets (jbuilder-utop.1))
|
||||
(action (with-stdout-to ${@}
|
||||
(run ${bin:jbuilder} utop --help=groff)))))
|
||||
|
||||
(install
|
||||
((section man)
|
||||
(files (jbuilder-utop.1))))
|
||||
|
|
@ -537,6 +537,34 @@ The difference between ``copy_files`` and ``copy_files#`` is the same
|
|||
as the difference between the ``copy`` and ``copy#`` action. See the
|
||||
`User actions`_ section for more details.
|
||||
|
||||
include
|
||||
-------
|
||||
|
||||
The ``include`` stanza allows to include the contents of another file
|
||||
into the current jbuild file. Currently, the included file cannot be
|
||||
generated and must be present in the source tree. This feature is
|
||||
intended to be used in conjunction with promotion, when parts of a
|
||||
jbuild file are to be generated.
|
||||
|
||||
For instance:
|
||||
|
||||
.. code:: scheme
|
||||
|
||||
(include jbuild.inc)
|
||||
|
||||
(rule (with-stdout-to jbuild.inc.gen (run ./gen-jbuild.exe)))
|
||||
|
||||
(alias
|
||||
((name jbuild)
|
||||
(action (promote (jbuild.inc.gen as jbuild.inc)))))
|
||||
|
||||
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 --promote copy
|
||||
|
||||
Common items
|
||||
============
|
||||
|
||||
|
@ -986,6 +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 it does nothing when the files to
|
||||
copy don't exist. This can be used with command that only produce a
|
||||
correction when differences are found
|
||||
|
||||
As mentioned ``copy#`` inserts a line directive at the beginning of
|
||||
the destination file. More precisely, it inserts the following line:
|
||||
|
@ -1103,6 +1137,37 @@ is global to all build contexts, simply use an absolute filename:
|
|||
|
||||
.. _ocaml-syntax:
|
||||
|
||||
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.
|
||||
|
||||
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:
|
||||
|
||||
- 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
|
||||
|
||||
How jbuilder interprets promotions can be controlled using the
|
||||
``--promote`` command line argument. The following behaviors are
|
||||
available:
|
||||
|
||||
- ``--promote check``: this is the default. Jbuilder just checks that
|
||||
the two files given in each ``(<a> as <b>)`` form are equal. If not,
|
||||
it prints a diff
|
||||
- ``--promote ignore``: ``promote`` actions are simply ignored
|
||||
- ``--promote copy``: when the two files are different, jbuilder
|
||||
prints a diff and copies ``<a>`` to ``<b>`` directly in the source tree
|
||||
|
||||
Note that ``-p/--for-release-of-packages`` implies ``--promote
|
||||
ignore``.
|
||||
|
||||
OCaml syntax
|
||||
============
|
||||
|
||||
|
|
|
@ -0,0 +1,26 @@
|
|||
#!/bin/bash
|
||||
|
||||
# CR-someday jdimino: maybe it's possible to get cmdliner to print that directly
|
||||
|
||||
set -e -o pipefail
|
||||
|
||||
jbuilder=$1
|
||||
|
||||
CMDS=$($jbuilder --help=plain | \
|
||||
sed -n '/COMMANDS/,/OPTIONS/p' | sed -En 's/^ ([a-z-]+)/\1/p')
|
||||
|
||||
for cmd in $CMDS; do
|
||||
cat <<EOF
|
||||
|
||||
(rule
|
||||
((targets (jbuilder-$cmd.1))
|
||||
(action (with-stdout-to \${@}
|
||||
(run \${bin:jbuilder} $cmd --help=groff)))))
|
||||
|
||||
(install
|
||||
((section man)
|
||||
(files (jbuilder-$cmd.1))))
|
||||
EOF
|
||||
done
|
||||
|
||||
echo
|
|
@ -222,14 +222,16 @@ follows:
|
|||
|
||||
build: [["jbuilder" "build" "-p" name "-j" jobs]]
|
||||
|
||||
``-p pkg`` is a shorthand for ``--root . --only-packages pkg``. ``-p``
|
||||
is the short version of ``--for-release-of-packages``.
|
||||
``-p pkg`` is a shorthand for ``--root . --only-packages pkg --promote
|
||||
ignore``. ``-p`` is the short version of
|
||||
``--for-release-of-packages``.
|
||||
|
||||
This has the following effects:
|
||||
|
||||
- it tells jbuilder to build everything that is installable and to
|
||||
ignore packages other than ``name`` defined in your project
|
||||
- it sets the root to prevent jbuilder from looking it up
|
||||
- it ignores promotion to cut down dependencies and speed up the build
|
||||
- it uses whatever concurrency option opam provides
|
||||
|
||||
Note that ``name`` and ``jobs`` are variables expanded by opam. ``name``
|
||||
|
|
|
@ -12,6 +12,8 @@ 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
|
||||
|
@ -29,6 +31,14 @@ 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
|
||||
|
@ -59,9 +69,16 @@ 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 })
|
||||
]
|
||||
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
|
||||
|
@ -93,6 +110,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)
|
||||
|
||||
let run prog args = Run (prog, args)
|
||||
let chdir path t = Chdir (path, t)
|
||||
|
@ -149,6 +170,12 @@ 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 }
|
||||
end
|
||||
|
||||
module Prog = struct
|
||||
|
@ -395,6 +422,15 @@ 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 }
|
||||
end
|
||||
|
||||
module E = struct
|
||||
|
@ -496,6 +532,15 @@ 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 }
|
||||
end
|
||||
|
||||
let fold_one_step t ~init:acc ~f =
|
||||
|
@ -517,7 +562,8 @@ let fold_one_step t ~init:acc ~f =
|
|||
| Rename _
|
||||
| Remove_tree _
|
||||
| Mkdir _
|
||||
| Digest_files _ -> acc
|
||||
| Digest_files _
|
||||
| Promote _ -> acc
|
||||
|
||||
include Make_mapper(Ast)(Ast)
|
||||
|
||||
|
@ -688,6 +734,36 @@ 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
|
||||
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)
|
||||
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 } ->
|
||||
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)));
|
||||
Future.all_unit (List.map not_ok ~f:(fun { Promote. src; dst } ->
|
||||
Diff.print dst src))
|
||||
end
|
||||
|
||||
and redirect outputs fn t ~ectx ~dir ~env_extra ~stdout_to ~stderr_to =
|
||||
let fn = Path.to_string fn in
|
||||
|
@ -752,6 +828,13 @@ 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 }
|
||||
|
||||
|
@ -771,6 +854,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)
|
||||
| Echo _
|
||||
| System _
|
||||
| Bash _
|
||||
|
@ -812,6 +897,9 @@ 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)
|
||||
| Echo _
|
||||
| System _
|
||||
| Bash _
|
||||
|
@ -839,6 +927,9 @@ 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)
|
||||
| Echo _
|
||||
| System _
|
||||
| Bash _
|
||||
|
|
|
@ -14,6 +14,8 @@ 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
|
||||
|
|
|
@ -5,11 +5,26 @@ 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
|
||||
type file = { src : path; dst : path }
|
||||
|
||||
type t =
|
||||
{ mode : Promote_mode.t
|
||||
; files : file list
|
||||
}
|
||||
end
|
||||
|
||||
type t =
|
||||
| Run of program * string list
|
||||
| Chdir of path * t
|
||||
|
@ -29,6 +44,7 @@ module type Ast = sig
|
|||
| Remove_tree of path
|
||||
| Mkdir of path
|
||||
| Digest_files of path list
|
||||
| Promote of Promote.t
|
||||
end
|
||||
|
||||
module type Helpers = sig
|
||||
|
|
|
@ -10,3 +10,22 @@ let workspace_root = ref "."
|
|||
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.Check
|
||||
|
|
|
@ -35,3 +35,19 @@ val capture_outputs : bool ref
|
|||
|
||||
(** Always print backtraces, to help debugging jbuilder itself *)
|
||||
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
|
||||
|
|
|
@ -0,0 +1,43 @@
|
|||
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 ()
|
|
@ -0,0 +1,2 @@
|
|||
(** Diff two files that are expected not to match. *)
|
||||
val print : Path.t -> Path.t -> _ Future.t
|
|
@ -66,6 +66,12 @@ let file_in_current_dir sexp =
|
|||
of_sexp_error sexp "file in current directory expected";
|
||||
fn
|
||||
|
||||
let relative_file sexp =
|
||||
let fn = file sexp in
|
||||
if not (Filename.is_relative fn) then
|
||||
of_sexp_error sexp "relative filename expected";
|
||||
fn
|
||||
|
||||
module Scope = struct
|
||||
type t =
|
||||
{ name : string option
|
||||
|
@ -926,6 +932,14 @@ module Stanza = struct
|
|||
| Install of Install_conf.t
|
||||
| Alias of Alias_conf.t
|
||||
| Copy_files of Copy_files.t
|
||||
end
|
||||
|
||||
module Stanzas = struct
|
||||
type t = Stanza.t list
|
||||
|
||||
type syntax = OCaml | Plain
|
||||
|
||||
open Stanza
|
||||
|
||||
let rules l = List.map l ~f:(fun x -> Rule x)
|
||||
|
||||
|
@ -934,7 +948,7 @@ module Stanza = struct
|
|||
| None -> [Executables exe]
|
||||
| Some i -> [Executables exe; Install i]
|
||||
|
||||
let v1 pkgs =
|
||||
let rec v1 pkgs : Stanza.t list Sexp.Of_sexp.t =
|
||||
sum
|
||||
[ cstr "library" (Library.v1 pkgs @> nil) (fun x -> [Library x])
|
||||
; cstr "executable" (Executables.v1_single pkgs @> nil) execs
|
||||
|
@ -951,30 +965,36 @@ module Stanza = struct
|
|||
(fun glob -> [Copy_files {add_line_directive = true; glob}])
|
||||
(* Just for validation and error messages *)
|
||||
; cstr "jbuild_version" (Jbuild_version.t @> nil) (fun _ -> [])
|
||||
; cstr_loc "include" (relative_file @> nil) (fun loc fn ->
|
||||
let dir = Filename.dirname loc.start.pos_fname in
|
||||
let fn =
|
||||
if dir <> Filename.current_dir_name then
|
||||
Filename.concat dir fn
|
||||
else
|
||||
fn
|
||||
in
|
||||
let sexps = Sexp.load ~fname:fn ~mode:Many in
|
||||
parse pkgs sexps ~default_version:Jbuild_version.V1)
|
||||
]
|
||||
|
||||
let select : Jbuild_version.t -> Scope.t -> t list Sexp.Of_sexp.t = function
|
||||
and select : Jbuild_version.t -> Scope.t -> Stanza.t list Sexp.Of_sexp.t = function
|
||||
| V1 -> v1
|
||||
end
|
||||
|
||||
module Stanzas = struct
|
||||
type t = Stanza.t list
|
||||
|
||||
let parse pkgs sexps =
|
||||
and parse ?(default_version=Jbuild_version.latest_stable) pkgs sexps =
|
||||
let versions, sexps =
|
||||
List.partition_map sexps ~f:(function
|
||||
| List (loc, [Atom (_, "jbuild_version"); ver]) ->
|
||||
| List (loc, [Atom (_, "jbuild_version"); ver]) ->
|
||||
Inl (Jbuild_version.t ver, loc)
|
||||
| sexp -> Inr sexp)
|
||||
in
|
||||
let version =
|
||||
match versions with
|
||||
| [] -> Jbuild_version.latest_stable
|
||||
| [] -> default_version
|
||||
| [(v, _)] -> v
|
||||
| _ :: (_, loc) :: _ ->
|
||||
Loc.fail loc "jbuild_version specified too many times"
|
||||
in
|
||||
List.concat_map sexps ~f:(Stanza.select version pkgs)
|
||||
List.concat_map sexps ~f:(select version pkgs)
|
||||
|
||||
let lib_names ts =
|
||||
List.fold_left ts ~init:String_set.empty ~f:(fun acc (_, _, stanzas) ->
|
||||
|
|
|
@ -260,6 +260,12 @@ end
|
|||
module Stanzas : sig
|
||||
type t = Stanza.t list
|
||||
|
||||
val parse : Scope.t -> Sexp.Ast.t list -> t
|
||||
type syntax = OCaml | Plain
|
||||
|
||||
val parse
|
||||
: ?default_version:Jbuild_version.t
|
||||
-> Scope.t
|
||||
-> Sexp.Ast.t list
|
||||
-> t
|
||||
val lib_names : (_ * _ * t) list -> String_set.t
|
||||
end
|
||||
|
|
|
@ -169,3 +169,10 @@
|
|||
(action
|
||||
(chdir test-cases/cross-compilation
|
||||
(setenv JBUILDER ${bin:jbuilder} (run ${exe:cram.exe} run.t))))))
|
||||
|
||||
(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))))))
|
||||
|
|
|
@ -0,0 +1,7 @@
|
|||
(jbuild_version 1)
|
||||
|
||||
(rule (with-stdout-to x.gen (echo "toto")))
|
||||
|
||||
(alias
|
||||
((name blah)
|
||||
(action (promote (x.gen as x)))))
|
|
@ -0,0 +1,21 @@
|
|||
$ echo titi > x
|
||||
|
||||
$ $JBUILDER build --root . -j1 --diff-command false @blah
|
||||
sh (internal) (exit 1)
|
||||
/usr/bin/sh -c 'false '\''x'\'' '\''_build/default/x.gen'\'''
|
||||
[1]
|
||||
$ cat x
|
||||
titi
|
||||
|
||||
$ $JBUILDER build --root . -j1 --diff-command false @blah --promote ignore
|
||||
$ cat x
|
||||
titi
|
||||
|
||||
$ $JBUILDER build --root . -j1 --diff-command false @blah --promote copy
|
||||
sh (internal) (exit 1)
|
||||
/usr/bin/sh -c 'false '\''x'\'' '\''_build/default/x.gen'\'''
|
||||
Promoting _build/default/x.gen to x.
|
||||
[1]
|
||||
$ cat x
|
||||
toto
|
||||
$ $JBUILDER build --root . -j1 --diff-command false @blah --promote copy
|
Loading…
Reference in New Issue