matthieu
/
dune
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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:
Jérémie Dimino 2018-01-15 13:24:25 +00:00 committed by GitHub
parent f8617b5721
commit eab1ff6c7b
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
20 changed files with 528 additions and 148 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
CHANGES.md
View File

@ -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
View File

@ -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
View File

@ -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
View File

@ -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)))))

100
doc/jbuild.inc Normal file
View File

@ -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))))

65
doc/jbuild.rst
View File

@ -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
============

26
doc/update-jbuild.sh Executable file
View File

@ -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

6
doc/usage.rst
View File

@ -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``

93
src/action.ml
View File

@ -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 _

2
src/action.mli
View File

@ -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

16
src/action_intf.ml
View File

@ -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

19
src/clflags.ml
View File

@ -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

16
src/clflags.mli
View File

@ -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

43
src/diff.ml Normal file
View File

@ -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 ()

2
src/diff.mli Normal file
View File

@ -0,0 +1,2 @@
(** Diff two files that are expected not to match. *)
val print : Path.t -> Path.t -> _ Future.t

40
src/jbuild.ml
View File

@ -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) ->

8
src/jbuild.mli
View File

@ -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

7
test/blackbox-tests/jbuild
View File

@ -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))))))

7
test/blackbox-tests/test-cases/promote/jbuild Normal file
View File

@ -0,0 +1,7 @@
(jbuild_version 1)
(rule (with-stdout-to x.gen (echo "toto")))
(alias
((name blah)
(action (promote (x.gen as x)))))

21
test/blackbox-tests/test-cases/promote/run.t Normal file
View File

@ -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